Loop code

[redspanna]

Hi All

I have following code that works fine..

Sub Report_Data()
Dim NextRow As Long
Dim rng As Range
Set rng = Sheets("Copied Data").Range("L" & Rows.Count).End(xlUp).Resize(1, 8)
Application.ScreenUpdating = False
Sheets("copied data").Select
Range("A1:BB50").Select
Selection.ClearContents
Sheets("database").Select
Range("A1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$AW$7890").AutoFilter Field:=49, Criteria1:="[COLOR="#FF0000"].Sheets("Pivots").Range("E4")[/COLOR]

'copy filtered data
Cells.Select
Selection.Copy
Sheets("copied data").Select
Cells.Select
Range("a1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Range("C2:C28").Select
Selection.Replace What:="0", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

With Sheets("Copied Data")
    NextRow = .Cells(Rows.Count, "L").End(xlUp).Row + 1
    .Range("L" & NextRow).Formula = "=SUM(L2:L" & NextRow - 1 & ")/('Report data'!$D$3-(COUNTIF(L2:L" & NextRow - 1 & ",""NA"")))"
    .Range("L" & NextRow & ":AR" & NextRow).FillRight

Sheets("Copied Data").Range("L" & Rows.Count).End(xlUp).Resize(1, 33).Copy
Sheets("Report Data")[COLOR="#FF0000"].Range("F2")[/COLOR].PasteSpecial Paste:=xlValues, Transpose:=True

End With
End Sub

I would like it to loop until no values in the Sheet 'Pivot' Range E4:E15 have been found

Also as each loop is completed the pasted data is pasted into a fresh cell...

So on first running the cell value from Pivot Sheet cell E4 is used for the Filter and the eventual copied data will be pasted into Report Data sheet cell F2 as above in RED
on next run the cell value from Pivot Sheet cell E5 is used for the Filter and the eventual copied data will be pasted into Report Data sheet cell G2
on next run the cell value from Pivot Sheet cell E6 is used for the Filter and the eventual copied data will be pasted into Report Data sheet cell H2
on next run the cell value from Pivot Sheet cell E7 is used for the Filter and the eventual copied data will be pasted into Report Data sheet cell I2
and so on until NO values are found in range E4:E15 of the Pivot sheet

Hope this makes sense and many thanks in advance

 

[Craggs82]

Hey Red,

Theres alot that could be done to improve this sub, steering away from the many select statements etc, but i'm a bit rushed for time at the mo.

a simple for loop should be enough to cycle through the cells, both for the filter and the paste location.

Sub Report_Data()

    Dim NextRow As Long
    Dim rng As Range
    Dim i As Byte
    
    Set rng = Sheets("Copied Data").Range("L" & Rows.Count).End(xlUp).Resize(1, 8)
        
        Application.ScreenUpdating = False

        Sheets("copied data").Select
        
        Range("A1:BB50").Select
        
        Selection.ClearContents
            
        For i = 4 To 15 'Loop starts here
        
            Sheets("database").Select
            
            Range("A1").Select
            
            Selection.AutoFilter
            
            ActiveSheet.Range("$A$1:$AW$7890").AutoFilter Field:=49, Criteria1:=.Sheets("Pivots").Cells(5, i) 'uses i value to reference the row
            
            'copy filtered data
            Cells.Select
            
            Selection.Copy
            
            Sheets("copied data").Select
            
            Cells.Select
            
            Range("a1").Select
            
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
            
            Range("C2:C28").Select
            
            Selection.Replace What:="0", Replacement:="", LookAt:=xlPart, _
                    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                    ReplaceFormat:=False
            
            With Sheets("Copied Data")
                NextRow = .Cells(Rows.Count, "L").End(xlUp).Row + 1
                .Range("L" & NextRow).Formula = "=SUM(L2:L" & NextRow - 1 & ")/('Report data'!$D$3-(COUNTIF(L2:L" & NextRow - 1 & ",""NA"")))"
                .Range("L" & NextRow & ":AR" & NextRow).FillRight
            
                Sheets("Copied Data").Range("L" & Rows.Count).End(xlUp).Resize(1, 33).Copy
                Sheets("Report Data").Cells(i + 2, 2).PasteSpecial Paste:=xlValues, Transpose:=True 'uses i+2 to reference the column. These increase as the loop progresses
            
            End With
            
        Next i
        
End Sub

good luck!