The complete code is as follows

Sub RunReportForEachCustomer() Dim IRange As Range Dim ORange As Range Dim CRange As Range Dim WBN As Workbook Dim WSN As Worksheet Dim WSO As Worksheet

Set WSO = ActiveSheet ' Find the size of today's dataset FinalRow = Cells(65536, 1).End(xlUp).Row NextCol = Cells(1, 255).End(xlToLeft).Column + 2

1 First - get a unique list of customers in J ' Set up output range. Copy heading from D1 there Range("D1").Copy Destination:=Cells(1, NextCol) Set ORange = Cells(1, NextCol)

1 Define the Input Range

Set IRange = Range("A1").Resize(FinalRow, NextCol - 2)

1 Do the Advanced Filter to get unique list of customers IRange.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:="", CopyToRange:=ORange, Unique:=True

1 Loop through each customer

FinalCust = Cells(65536, NextCol).End(xlUp).Row For Each cell In Cells(2, NextCol).Resize(FinalCust - 1, 1) ThisCust = cell.Value

' Set up the Criteria Range with one customer Cells(1, NextCol + 2).Value = Range("D1").Value Cells(2, NextCol + 2).Value = ThisCust Set CRange = Cells(1, NextCol + 2).Resize(2, 1)

1 Set up output range. We want Date, Quantity, Product, Revenue ' These columns are in C, E, B, and F Cells(1, NextCol + 4).Resize(1, 4).Value = _

Array(Cells(1, 3), Cells(1, 5), Cells(1, 2), Cells(1, 6)) Set ORange = Cells(1, NextCol + 4).Resize(1, 4)

' Do the Advanced Filter to get unique list of customers & product IRange.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=CRange, CopyToRange:=ORange

1 Create a new workbook with one blank sheet to hold the output Set WBN = Workbooks.Add(xlWBATWorksheet) Set WSN = WBN.Worksheets(1)

1 Copy data from WSO to WSN

WSO.Cells(1, NextCol + 4).CurrentRegion.Copy _ Destination:=WSN.Cells(3, 1)

WSN.Cells(1, 1).Value = "Report of Sales to " & ThisCust

TotalRow = WSN.Cells(65536, 1).End(xlUp).Row + 1 WSN.Cells(TotalRow, 1).Value = "Total" WSN.Cells(TotalRow, 2).FormulaR1C1 = "=SUM(R2C:R[-1]C)" WSN.Cells(TotalRow, 4).FormulaR1C1 = "=SUM(R2C:R[-1]C)"

' Format the new report with bold WSN.Cells(3, 1).Resize(1, 4).Font.Bold = True WSN.Cells(TotalRow, 1).Resize(1, 4).Font.Bold = True WSN.Cells(1, 1).Font.Size = 18

0 0

Post a comment