Info

' 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 1 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 ' Add Total information totalrow = WSO.Cells(65536, ORange.Columns(1).Column).End(xlUp).Row + 1 WSO.Cells(totalrow, ORange.Columns(1).Column).Value = "Total" WSO.Cells(totalrow, ORange.Columns(2).Column).FormulaR1C1 = _

"=SUM(R2C:R[-1]C)" WSO.Cells(totalrow, ORange.Columns(4).Column).FormulaR1C1 = _

"=SUM(R2C:R[-1]C)" ' Create a new document to hold the output On Error Resume Next 'Set wdDoc = New Word.Document Set wdApp = GetObject(, "Word.Application")

If wdApp Is Nothing Then Set wdApp = GetObject("", "Word.Application") Set wdDoc = wdApp.Documents.Add(Template:= _ "C:\Reports\MrExcel SalesTemplate.dot") wdDoc.Activate

' Set up a title on the document wdDoc.Bookmarks("Client").Range.InsertBefore (ThisCust)

1 Copy data from WSO to wdDoc

WSO.Cells(1, NextCol + 4).CurrentRegion.Copy

Set wdRng = wdApp.ActiveDocument.Bookmarks("Table").Range wdRng.Select

0 0

Post a comment