Nested for Loop

Arae97

New Member
Joined
Jun 4, 2019
Messages
7
I can't seem to figure out how to jump to the next "c" in the loop after pasting my data. it works the first time but does not return to the first loop to change the c value to continue the process. any help would be great

Sub CopyPasteData()
Dim Pool As Worksheet
Dim Family As Range
Dim i As Integer
Dim Finalrow As Integer
Dim c As Variant
Set Pool = Sheet1
Set Family = Pool.Range("R2:R16")
Pool.Select
Finalrow = Cells(Rows.Count, 1).End(xlUp).Row


For Each c In Family


For i = 2 To Finalrow
If Cells(i, 1) = c.Value Then
Range(Cells(i, 2), Cells(i, 13)).Copy
Sheets(c.Value).Select
Range("a3").End(xlToRight).Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Transpose:=True
Pool.Select
End If
Exit For

Next c


End Sub
[/code]
 
@Steve_
Please do not quote posts in full as it just clutters up the thread.
 
Upvote 0

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
If the msgbox only appeared once, then there is something else going on.
Is the code in post#5 your EXACT code, or have you taken bits out?
Also when stepping through the code with F8 does any other code run?
 
Upvote 0
Sub CopyPasteData()
Dim i As Integer, c As Variant
Dim Pool As Worksheet
Set Pool = Sheet1
ThisWorkbook.Sheets("Pool").Activate
For Each c In Pool.Range("R2:R16")
For i = 2 To Pool.UsedRange.Rows.Count
If Cells(i, 1) = c.Value Then
Range(Cells(i, 2), Cells(i, 13)).Copy
Sheets(c.Value).Select
Range("a3").End(xlToRight).Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Transpose:=True
Sheets("Pool").Activate
Exit For
End If
Next i
Next c
End Sub
@Steve_
I modified you suggestion and it is seeming to work. But how would I or where would I add an If Error or a go to next if the c.value cannot be found in the used range.
 
Last edited:
Upvote 0
@Fluff

It is my exact code. and no other code runs. that is why i seemed to be stumped. the code from steve seems to work but is a little slow. but as long as the query works.
 
Last edited:
Upvote 0
In that case I've no idea why it's not working, but does this do what you need?
Code:
Sub Area97()
   Dim ary As Variant
   Dim i As Long
   
   With Sheet1
      ary = .Range("R2:R16").Value2
      For i = 1 To UBound(ary)
         If ary(i, 1) <> "" Then
            .Range("A1:M1").AutoFilter 1, ary(i, 1)
            .AutoFilter.Range.Offset(1, 1).Copy
            Sheets(ary(i, 1)).Range("A3").End(xlToRight).Offset(, 1).PasteSpecial xlPasteValues, , , True
         End If
      Next i
      .AutoFilterMode = False
   End With
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,910
Messages
6,175,318
Members
452,634
Latest member
cpostell

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top