Creating a Nested loop (copy between worksheet) within loop of auto-filtered criteria

[winrow]

Hello,

I am newly registered but not new to search in this forum for new approaches of better structuring my vba code. Still, now I am facing a wall with which I think the solution would be a nested loop (but I might be mistaken).

Document: 1 workbook, 13 sheets (the first is called "sheet1", the last one is called "compilation", in between sheets named "1" till "11")
Datasheet: "sheet1", data structured in columns A (question with number 01 till 11), columns B (contributors' name alphabetically ordered), column C (answer). The number of rows is the same in between the 3 columns.

What I have: a VBA code that runs a loop that will autofilter through the questions numbers and copy the filtered results to a worksheet.

Sub fun()
 
Dim o_cell As Range
Dim wkD As Worksheet
Dim LR As Variant
Dim i As Integer

'source data
Set o_cell = ThisWorkbook.Worksheets("<wbr>Sheet1").Range("A1").<wbr>CurrentRegion

'Destination sheet that is set 
Set wkD = ThisWorkbook.Worksheets("1")
 
'set Lastrow for column A. Columns A,B & C have the same number of rows
LR = o_cell.Cells(Rows.Count, 1).End(xlUp).Row
 
    For i = 1 To 11
   
        o_cell.AutoFilter field:=1, Criteria1:="=" & i & ".*", Operator:=xlAnd
        Range("A1:C" & LR).Copy
            wkD.Range("A1").PasteSpecial Paste:=xlPasteValues
        o_cell.AutoFilter
       
    Next i
 
End Sub

What I would like to do: the above code successively autofilter results from question 01 to 11 and copy-paste the results into another sheet that remains worksheet ("1"). Is it possible to modify this code to copy filtered results from question 1 to sheet "1", from question 2 to sheet "2" etc. till question 11 to sheet "11"? In the affirmative, how would you do it?

Many thanks in advance for your help!

 

[Georgiboy]

Re: Help in creating a Nested loop (copy between worksheet) within loop of auto-filtered criteria

Maybe try:

Sub fun() 
    Dim o_cell As Range
    Dim wkD As Worksheet
    Dim LR As Variant
    Dim i As Long


    'source data
    Set o_cell = ThisWorkbook.Worksheets("Sheet1").Range("A1").CurrentRegion
    
    'set Lastrow for column A. Columns A,B & C have the same number of rows
    LR = o_cell.Cells(Rows.Count, 1).End(xlUp).Row
 
    For i = 1 To 11
        'Destination sheet that is set
        Set wkD = ThisWorkbook.Worksheets(i)
   
        o_cell.AutoFilter field:=1, Criteria1:="=" & i & ".*", Operator:=xlAnd
        Range("A1:C" & LR).Copy
            wkD.Range("A1").PasteSpecial Paste:=xlPasteValues
        o_cell.AutoFilter
    Next i
 
End Sub

Untested

Hope this helps

 

[winrow]

Re: Help in creating a Nested loop (copy between worksheet) within loop of auto-filtered criteria

Hi,

Thanks for the prompt reply. It is almost perfect expect from a shift. With this line of code,

 Set wkD = ThisWorkbook.Worksheets(i)

the outcomes of question 01 will land on the data sheet "sheet1" instead of sheet "1". Is there any way to increment of 1 the starting wkD?

PS: your feedback made me realize a mistake in my autofilter criteria1 that should in fact be (yes, the questions numbers are referenced as 01,02,03,...11) - Already thanks for that

Criteria1:="?" & i & ".*"

 

[Georgiboy]

Re: Help in creating a Nested loop (copy between worksheet) within loop of auto-filtered criteria

How about:

Sub fun()    
    Dim o_cell As Range
    Dim wkD As Worksheet
    Dim LR As Variant
    Dim i As Long, x As String

    'source data
    Set o_cell = ThisWorkbook.Worksheets("Sheet1").Range("A1").CurrentRegion
    
    'set Lastrow for column A. Columns A,B & C have the same number of rows
    LR = o_cell.Cells(Rows.Count, 1).End(xlUp).Row
 
    For i = 1 To 11
        'Destination sheet that is set
        x = i
        Set wkD = ThisWorkbook.Worksheets(x)
   
        o_cell.AutoFilter field:=1, [COLOR=#333333]Criteria1:="?" & i & ".*"[/COLOR], Operator:=xlAnd
        Range("A1:C" & LR).Copy
            wkD.Range("A1").PasteSpecial Paste:=xlPasteValues
        o_cell.AutoFilter
    Next i
 
End Sub

 

[Fluff]

Re: Help in creating a Nested loop (copy between worksheet) within loop of auto-filtered criteria

You may need to tweak Georgiboy code slightly like this

x = Format(i, "00")

to get the correct sheet names

 

[winrow]

Re: Help in creating a Nested loop (copy between worksheet) within loop of auto-filtered criteria

Wonderful, I could use your way around to make it work! Here is the full code (I had to make a second loop for questions 10 and 11). I learnt quite a lot with your suggestions, Thanks!

Sub fun()
Dim o_cell As Range
Dim wkD As Worksheet
Dim LR As Variant
Dim i,x As Integer

'source data
Set o_cell = ThisWorkbook.Worksheets("Sheet1").Range("A1").CurrentRegion

'set Lastrow for column A. Columns A,B & C have the same number of rows
LR = o_cell.Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To 9
'Destination sheet that is set
x = i+1
Set wkD = ThisWorkbook.Worksheets(x)

o_cell.AutoFilter field:=1, Criteria1:="0" & i & ".*", Operator:=xlAnd
Range("A1:C" & LR).Copy
wkD.Range("A1").PasteSpecial Paste:=xlPasteValues
o_cell.AutoFilter
Next i

For i=10 to 11

x= i+1

Set wkD= ThisWorkbook.worksheet(x)

o_cell.Autofilter field:=1, Criteria:="=" & i & ".*", Operator:=xlAnd
Range("A1:C" & LR).Copy
wkD.Range("A1").PasteSpecial Paste:=xlPasteValues
o_cell.Autofilter
Next i

End Sub

 

[winrow]

Re: Help in creating a Nested loop (copy between worksheet) within loop of auto-filtered criteria

Thanks Fluff. I tried your tweak to remove the second loop but it is not working. I will dig in further to learn more but I am already really happy with the solution we came up with. It does significantly reduce the code length from the macro recorder I had at first (repeated for each filtered criteria)

 

[Georgiboy]

Re: Help in creating a Nested loop (copy between worksheet) within loop of auto-filtered criteria

Try This:

Sub fun()    
    Dim o_cell As Range
    Dim wkD As Worksheet
    Dim LR As Variant
    Dim i As Long, x As String
    
    'source data
    Set o_cell = ThisWorkbook.Worksheets("Sheet1").Range("A1").CurrentRegion
    
    'set Lastrow for column A. Columns A,B & C have the same number of rows
    LR = o_cell.Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 1 To 11
        'Destination sheet that is set
        x = Format(i + 1, "00")
        MsgBox x
        Set wkD = ThisWorkbook.Worksheets(x)
        
        o_cell.AutoFilter field:=1, Criteria1:="0" & i & ".*", Operator:=xlAnd
        Range("A1:C" & LR).Copy
        wkD.Range("A1").PasteSpecial Paste:=xlPasteValues
        o_cell.AutoFilter
    Next i
End Sub

I noticed you had dimmed x as integer, x needs to stay a string for this to work.

Now when you add Fluff's code it should work (see above)

One last thing to note:

If you do this:
Dim i,x As Integer

i does not get dimmed as anything

Needs to be
Dim i As Long, x As String

Hope this helps

 

[Fluff]

Re: Help in creating a Nested loop (copy between worksheet) within loop of auto-filtered criteria

If you want questions 01 to go to a sheet called 01 try (untested)

Sub fun()
    Dim o_cell As Range
    Dim wkD As Worksheet
    Dim LR As Variant
    Dim i As Long, x As String
    
    'source data
    Set o_cell = ThisWorkbook.Worksheets("Sheet1").Range("A1").CurrentRegion
    
    'set Lastrow for column A. Columns A,B & C have the same number of rows
    LR = o_cell.Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 1 To 11
        'Destination sheet that is set
        [COLOR=#ff0000]x = Format(i, "00")[/COLOR]
        MsgBox x
        Set wkD = ThisWorkbook.Worksheets(x)
        
        o_cell.AutoFilter field:=1, Criteria1:=[COLOR=#ff0000]x & ".*"[/COLOR], Operator:=xlAnd
        Range("A1:C" & LR).Copy
        wkD.Range("A1").PasteSpecial Paste:=xlPasteValues
        o_cell.AutoFilter
    Next i
End Sub

 

[Georgiboy]

Whoops

Thanks Fluff, missed the Criteria1 part.

Also wasn’t sure where the +1 had come from either.

Cheers