I have a worksheet with sales data, I've managed to create Autofilter based on department and copied the results into the new sheet (Output). What I'm trying to achieve is that code will multiply the results of respective month by value in "Adjustment" row.

So the result is following

Is there a way how to process calculations within my code or I shall multiply each column in different Sub afterwards?

    Dim Last_Row As Long
    Dim DbExtract, DuplicateRecords As Worksheet
    Dim WKS2 As Worksheet
    Dim rn As Range
    Set DbExtract = ThisWorkbook.Sheets("Data")
    Set DuplicateRecords = ThisWorkbook.Sheets("Output")
    Set WKS2 = ThisWorkbook.Sheets("Dashboard")
    iMultiplier = WKS2.Range("Z18")
    
    Application.ScreenUpdating = False
    
    Last_Row = DuplicateRecords.Range("A" & Rows.Count).End(xlUp).Row   1

    DbExtract.Range("C3:R1500").SpecialCells(xlCellTypeVisible).Copy
    DuplicateRecords.Range("A" & Last_Row).PasteSpecial
    
    DuplicateRecords.Range("$A$1:$P$400").AutoFilter Field:=3, Criteria1:=WKS2.Range("V2")
   Set rn = DuplicateRecords.Range("G2:G500").SpecialCells(xlCellTypeVisible)
    
        For Each cell In rn
        iNewnumber = cell * iMultiplier
        Next cell

    
    


    End Sub

CodePudding user response：

Here's an example:

Sub Tester()

    Dim lastRow As Long, wb As Workbook
    Dim wsData As Worksheet, wsOutput As Worksheet
    Dim wsDash As Worksheet, rngVis As Range, numVisRows As Long
    Dim rn As Range, rngAdj As Range, m As Long, adj, c As Range
    
    Set wb = ThisWorkbook
    Set wsData = wb.Sheets("Data")   'consistent naming helps...
    Set wsOutput = wb.Sheets("Output")
    Set wsDash = wb.Sheets("Dashboard")
    
    'iMultiplier = wsDash.Range("Z18") '?
    
    Application.ScreenUpdating = False
    
    Set rngVis = wsData.Range("C3:R1500").SpecialCells(xlCellTypeVisible)
    numVisRows = rngVis.Cells.Count / rngVis.Columns.Count
    rngVis.Copy
    
    lastRow = wsOutput.Range("A" & Rows.Count).End(xlUp).Row   1 'start of pasted data
    wsOutput.Range("A" & lastRow).PasteSpecial
    
    Set rngAdj = wsDash.Range("C5:N5") 'for example
    For m = 1 To rngAdj.Columns.Count 'loop the cells in the adjustments range
        adj = rngAdj.Cells(m).Value   'adjustment value
        If Len(adj) > 0 And IsNumeric(adj) Then 'have an adjustment to make?
            'loop the relevant cells in the pasted data
            For Each c In wsOutput.Cells(lastRow, "A").Offset(0, 2   m).Resize(numVisRows).Cells
                If Len(c.Value) > 0 And IsNumeric(c.Value) Then 'any thing to adjust?
                    c.Value = c.Value * adj
                End If
            Next c
        End If
    Next m
    
End Sub