ignilealmomaa
New Member
With very limited knowledge of writing macros but having read a lot of material, I have written a code to organize a database into a worksheet with multiple groups of cells containing Accts. Payable data. The number of rows of these groups of cells vary but the columns are fixed (13) and they are separated by two empty rows.The part I am stuck on is that I now need to sort each group of rows by Customer name (col. 3) and Subtotal those names that have more than one Invoice and in the last row under the column labeled "Total" have the total amount of all the Invoices pertaining to that particular group. So far, I've only been able to come up with the code to "select" the first range of cells. A sample worksheet can be downloaded from here:https://www.dropbox.com/sh/j1h5nnib8esqxh8/GYaCiCFUZp/CXPRD.xlsThe Code to try in Excel is Available for download here:https://www.dropbox.com/sh/j1h5nnib8esqxh8/c8o0MYl1mZ/AP%20Code.basI've come up with this so far:Sub AP_Report()'' Organize Payables Macro'' Direct Access: CTRL+j' ActiveWindow.SmallScroll Down:=162 Dim rng As Range, cell As Range, del As Range Set rng = Intersect(Range("A1:q400"), ActiveSheet.UsedRange) For Each cell In rng If (cell.Value) = "US$" _ Then If del Is Nothing Then Set del = cell Else: Set del = Union(del, cell) End If End If Next cell On Error Resume Next del.EntireRow.Delete Range("A:B,F:G,I:I").Select Range("I16").Activate Selection.Delete Shift:=xlToLeft ActiveWindow.ScrollColumn = 7 ActiveWindow.ScrollColumn = 6 ActiveWindow.ScrollColumn = 5 ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 1 Columns("A:A").Select Range("A16").Activate Selection.Cut Columns("E:E").Select Range("E16").Activate Selection.Insert Shift:=xlToRight Columns("F:F").Select Range("F16").Activate Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove ActiveWindow.SmallScroll Down:=-66 Range("F1").Select ActiveCell.FormulaR1C1 = "vence" Columns("D
").Select Selection.Replace What:=" *", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Columns("D:O").Select Selection.ColumnWidth = 39.43 Selection.ColumnWidth = 10.14 Columns("M:O").Select Selection.ClearContents ActiveWindow.ScrollColumn = 9 ActiveWindow.ScrollColumn = 8 ActiveWindow.ScrollColumn = 7 ActiveWindow.ScrollColumn = 6 ActiveWindow.ScrollColumn = 5 ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 1 Range("D1").Select ActiveCell.FormulaR1C1 = "fecha fact" Range("H1").Select ActiveCell.FormulaR1C1 = "> 30 Dias" Range("I1").Select ActiveCell.FormulaR1C1 = "> 60 Dias" Range("J1").Select ActiveCell.FormulaR1C1 = "> 90 Dias" Range("K1").Select ActiveCell.FormulaR1C1 = " > 120 Dias" Range("L1").Select ActiveCell.FormulaR1C1 = " > 150 Dias" Range("M1").Select ActiveCell.FormulaR1C1 = "total" Range("N1").Select ActiveCell.FormulaR1C1 = "semana" Range("O1").Select ActiveCell.FormulaR1C1 = "rango" Range("Q1").Select ActiveCell.FormulaR1C1 = "=TODAY()" Range("R2").Select ActiveCell.FormulaR1C1 = "180" Range("R3").Select ActiveCell.FormulaR1C1 = "150" Range("R4").Select ActiveCell.FormulaR1C1 = "120" Range("R5").Select ActiveCell.FormulaR1C1 = "90" Range("R6").Select ActiveCell.FormulaR1C1 = "60" Range("R7").Select ActiveCell.FormulaR1C1 = "30" Range("S2").Select ActiveCell.FormulaR1C1 = "=R1C17-RC[-1]" Range("S2").Select Selection.AutoFill Destination:=Range("S2:S7"), Type:=xlFillDefault Range("S2:S7").Select Columns("S:S").Select Selection.NumberFormat = "[$-409]d-mmm;@" Columns("G:M").Select Selection.NumberFormat = "#,##0" Rows("1:1").Select Range("F1").Activate With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.Font.Bold = True Selection.Font.Underline = xlUnderlineStyleSingle ActiveWindow.ScrollColumn = 5 ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 1 Cells.Select ActiveWorkbook.Worksheets("CXCRD").Sort.SortFields.Clear ActiveWorkbook.Worksheets("CXCRD").Sort.SortFields.Add Key:=Range("B2:B253"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("CXCRD").Sort .SetRange Range("A1:Q253") .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Range("F2").Select ActiveCell.FormulaR1C1 = "=RC[-2]+RC[-1]" If IsEmpty(ActiveCell) Then Exit Sub Range(ActiveCell, ActiveCell.Offset(0, -1).End(xlDown).Offset(0, 1)).FillDown ActiveWorkbook.Worksheets("CXCRD").Sort.SortFields.Clear ActiveWorkbook.Worksheets("CXCRD").Sort.SortFields.Add Key:=Range("F2:F253"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("CXCRD").Sort .SetRange Range("A1:Q253") .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Range("R1").Select ActiveCell.FormulaR1C1 = "=(TODAY()-30)" Range("T8").Select ActiveCell.FormulaR1C1 = "=RC[-1]+6" Range("T8").Select Selection.AutoFill Destination:=Range("t8:t51"), Type:=xlFillDefault Range("S8").Select ActiveCell.FormulaR1C1 = "=R[-1]C-WEEKDAY(R[-1]C,2)+1" Range("S9").Select ActiveCell.FormulaR1C1 = "=R[-1]+7" Selection.AutoFill Destination:=Range("S9:S51"), Type:=xlFillDefault Columns("F:F").Select Selection.Copy Columns("V:V").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Columns("V:V").Select Selection.NumberFormat = "[$-409]d-mmm-yy;@" Range("X2").Select ActiveCell.FormulaR1C1 = "1" Range("X2").Select ActiveCell.FormulaR1C1 = "=R[-1]C+1" Range(ActiveCell, ActiveCell.Offset(0, -2).End(xlDown).Offset(0, 1)).FillDown Range("W2").Select ActiveCell.FormulaR1C1 = _ "=IF(R1C17-RC[-1]>=180,180,IF(R1C17-RC[-1]>=150,150,IF(R1C17-RC[-1]>=120,120,IF(R1C17-RC[-1]>=90,90,IF(R1C17-RC[-1]>=60,60,IF(R1C17-RC[-1]>=30,30,WEEKNUM(RC[-1],2)))))))" Range(ActiveCell, ActiveCell.Offset(0, 1).End(xlDown).Offset(0, 1)).FillDown Selection.AutoFill Destination:=Range("R8:R51"), Type:=xlFillDefault Range("N2").Select ActiveCell.FormulaR1C1 = "=IF(RC[9]<>R[1]C[9],RC[9],"""")" Range(ActiveCell, ActiveCell.Offset(0, -2).End(xlDown).Offset(0, 1)).FillDown Range("R8").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "=WEEKNUM(RC[1],2)" Selection.AutoFill Destination:=Range("R8:R51"), Type:=xlFillDefault Columns("N:N").Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Columns("V:X").Select Application.CutCopyMode = False Selection.ClearContents Range("n2").Select Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Dim irow As Long, vcurrent As String, i As Long '// find last used cell in Column A irow = Cells(Rows.Count, "N").End(xlUp).Row '// get value of that cell in Column A (column 1) vcurrent = Cells(irow, 14).Text '// rows are inserted by looping from bottom For i = irow To 2 Step -1 If Cells(i, 14).Text = "" Then vcurrent = Cells(i - 1, 1) ElseIf Cells(i, 14).Text <> vcurrent Then vcurrent = Cells(i, 14).Text Rows(i + 1).Resize(2).Insert End If Next i Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = TrueEnd SubCode to select the first range of cells:Sub selectrows()'' Macro15 Macro'R = 2c = 2x = 12Do Until Cells(R, c).Valuehttp://stackoverflow.com/questions/15910745/= ""R = R + 1LoopR = R - 1Range(Cells(2, 1), Cells(R, x)).SelectEnd SubAny and All help will be greatly appreciated!!
").Select Selection.Replace What:=" *", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Columns("D:O").Select Selection.ColumnWidth = 39.43 Selection.ColumnWidth = 10.14 Columns("M:O").Select Selection.ClearContents ActiveWindow.ScrollColumn = 9 ActiveWindow.ScrollColumn = 8 ActiveWindow.ScrollColumn = 7 ActiveWindow.ScrollColumn = 6 ActiveWindow.ScrollColumn = 5 ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 1 Range("D1").Select ActiveCell.FormulaR1C1 = "fecha fact" Range("H1").Select ActiveCell.FormulaR1C1 = "> 30 Dias" Range("I1").Select ActiveCell.FormulaR1C1 = "> 60 Dias" Range("J1").Select ActiveCell.FormulaR1C1 = "> 90 Dias" Range("K1").Select ActiveCell.FormulaR1C1 = " > 120 Dias" Range("L1").Select ActiveCell.FormulaR1C1 = " > 150 Dias" Range("M1").Select ActiveCell.FormulaR1C1 = "total" Range("N1").Select ActiveCell.FormulaR1C1 = "semana" Range("O1").Select ActiveCell.FormulaR1C1 = "rango" Range("Q1").Select ActiveCell.FormulaR1C1 = "=TODAY()" Range("R2").Select ActiveCell.FormulaR1C1 = "180" Range("R3").Select ActiveCell.FormulaR1C1 = "150" Range("R4").Select ActiveCell.FormulaR1C1 = "120" Range("R5").Select ActiveCell.FormulaR1C1 = "90" Range("R6").Select ActiveCell.FormulaR1C1 = "60" Range("R7").Select ActiveCell.FormulaR1C1 = "30" Range("S2").Select ActiveCell.FormulaR1C1 = "=R1C17-RC[-1]" Range("S2").Select Selection.AutoFill Destination:=Range("S2:S7"), Type:=xlFillDefault Range("S2:S7").Select Columns("S:S").Select Selection.NumberFormat = "[$-409]d-mmm;@" Columns("G:M").Select Selection.NumberFormat = "#,##0" Rows("1:1").Select Range("F1").Activate With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.Font.Bold = True Selection.Font.Underline = xlUnderlineStyleSingle ActiveWindow.ScrollColumn = 5 ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 1 Cells.Select ActiveWorkbook.Worksheets("CXCRD").Sort.SortFields.Clear ActiveWorkbook.Worksheets("CXCRD").Sort.SortFields.Add Key:=Range("B2:B253"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("CXCRD").Sort .SetRange Range("A1:Q253") .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Range("F2").Select ActiveCell.FormulaR1C1 = "=RC[-2]+RC[-1]" If IsEmpty(ActiveCell) Then Exit Sub Range(ActiveCell, ActiveCell.Offset(0, -1).End(xlDown).Offset(0, 1)).FillDown ActiveWorkbook.Worksheets("CXCRD").Sort.SortFields.Clear ActiveWorkbook.Worksheets("CXCRD").Sort.SortFields.Add Key:=Range("F2:F253"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("CXCRD").Sort .SetRange Range("A1:Q253") .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Range("R1").Select ActiveCell.FormulaR1C1 = "=(TODAY()-30)" Range("T8").Select ActiveCell.FormulaR1C1 = "=RC[-1]+6" Range("T8").Select Selection.AutoFill Destination:=Range("t8:t51"), Type:=xlFillDefault Range("S8").Select ActiveCell.FormulaR1C1 = "=R[-1]C-WEEKDAY(R[-1]C,2)+1" Range("S9").Select ActiveCell.FormulaR1C1 = "=R[-1]+7" Selection.AutoFill Destination:=Range("S9:S51"), Type:=xlFillDefault Columns("F:F").Select Selection.Copy Columns("V:V").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Columns("V:V").Select Selection.NumberFormat = "[$-409]d-mmm-yy;@" Range("X2").Select ActiveCell.FormulaR1C1 = "1" Range("X2").Select ActiveCell.FormulaR1C1 = "=R[-1]C+1" Range(ActiveCell, ActiveCell.Offset(0, -2).End(xlDown).Offset(0, 1)).FillDown Range("W2").Select ActiveCell.FormulaR1C1 = _ "=IF(R1C17-RC[-1]>=180,180,IF(R1C17-RC[-1]>=150,150,IF(R1C17-RC[-1]>=120,120,IF(R1C17-RC[-1]>=90,90,IF(R1C17-RC[-1]>=60,60,IF(R1C17-RC[-1]>=30,30,WEEKNUM(RC[-1],2)))))))" Range(ActiveCell, ActiveCell.Offset(0, 1).End(xlDown).Offset(0, 1)).FillDown Selection.AutoFill Destination:=Range("R8:R51"), Type:=xlFillDefault Range("N2").Select ActiveCell.FormulaR1C1 = "=IF(RC[9]<>R[1]C[9],RC[9],"""")" Range(ActiveCell, ActiveCell.Offset(0, -2).End(xlDown).Offset(0, 1)).FillDown Range("R8").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "=WEEKNUM(RC[1],2)" Selection.AutoFill Destination:=Range("R8:R51"), Type:=xlFillDefault Columns("N:N").Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Columns("V:X").Select Application.CutCopyMode = False Selection.ClearContents Range("n2").Select Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Dim irow As Long, vcurrent As String, i As Long '// find last used cell in Column A irow = Cells(Rows.Count, "N").End(xlUp).Row '// get value of that cell in Column A (column 1) vcurrent = Cells(irow, 14).Text '// rows are inserted by looping from bottom For i = irow To 2 Step -1 If Cells(i, 14).Text = "" Then vcurrent = Cells(i - 1, 1) ElseIf Cells(i, 14).Text <> vcurrent Then vcurrent = Cells(i, 14).Text Rows(i + 1).Resize(2).Insert End If Next i Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = TrueEnd SubCode to select the first range of cells:Sub selectrows()'' Macro15 Macro'R = 2c = 2x = 12Do Until Cells(R, c).Valuehttp://stackoverflow.com/questions/15910745/= ""R = R + 1LoopR = R - 1Range(Cells(2, 1), Cells(R, x)).SelectEnd SubAny and All help will be greatly appreciated!!