Loop through data, copy various values to new row on another tab

S

sserc

New Member
Joined
Jun 21, 2018
Messages
2
Worksheet1
[TABLE="class: ydpf8f6d4a8wysiwyg_dashes, width: 1000"]
<tbody>[TR]
[TD]LastName[/TD]
[TD]FirstName[/TD]
[TD]Code[/TD]
[TD]ID[/TD]
[TD]E[/TD]
[TD]Group[/TD]
[TD]Address[/TD]
[TD]H[/TD]
[TD]Group2[/TD]
[TD]Address2[/TD]
[TD]K[/TD]
[TD]Group3[/TD]
[TD]Address3[/TD]
[/TR]
[TR]
[TD]Smith[/TD]
[TD]John[/TD]
[TD]01, 03[/TD]
[TD]123456[/TD]
[TD][/TD]
[TD]Place1[/TD]
[TD]123 Main St.[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Jones[/TD]
[TD]Fred[/TD]
[TD]06[/TD]
[TD]852547[/TD]
[TD][/TD]
[TD]Place1[/TD]
[TD]123 Main St.[/TD]
[TD][/TD]
[TD]Place2[/TD]
[TD]345 Water St.[/TD]
[TD][/TD]
[TD]Place3[/TD]
[TD]567 High St.[/TD]
[/TR]
[TR]
[TD]White[/TD]
[TD]Barb[/TD]
[TD]03, 123, 04[/TD]
[TD]258787[/TD]
[TD][/TD]
[TD]Place1[/TD]
[TD]123 Main St.[/TD]
[TD][/TD]
[TD]Place2[/TD]
[TD]345 Water St.[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Collins[/TD]
[TD]Susan[/TD]
[TD]06, 03[/TD]
[TD]345214[/TD]
[TD][/TD]
[TD]Place2[/TD]
[TD]345 Water St.[/TD]
[TD][/TD]
[TD]Place4[/TD]
[TD]987 1st St.[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


Worksheet2
[TABLE="class: ydpf8f6d4a8wysiwyg_dashes, width: 500"]
<tbody>[TR]
[TD]LastName[/TD]
[TD]FirstName[/TD]
[TD]Code[/TD]
[TD]ID[/TD]
[TD]Group[/TD]
[TD]Address[/TD]
[/TR]
[TR]
[TD]Smith[/TD]
[TD]John[/TD]
[TD]01, 03[/TD]
[TD]123456[/TD]
[TD]Place1[/TD]
[TD]123 Main St.[/TD]
[/TR]
[TR]
[TD]Jones[/TD]
[TD]Fred[/TD]
[TD]06[/TD]
[TD]852547[/TD]
[TD]Place1[/TD]
[TD]123 Main St.[/TD]
[/TR]
[TR]
[TD]White[/TD]
[TD]Barb[/TD]
[TD]03, 123, 04[/TD]
[TD]258787[/TD]
[TD]Place1[/TD]
[TD]123 Main St.[/TD]
[/TR]
[TR]
[TD]Collins[/TD]
[TD]Susan[/TD]
[TD]06, 03[/TD]
[TD]345214[/TD]
[TD]Place2[/TD]
[TD]345 Water St.[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


I have original data structured like Worksheet1 above. In this example, columns E,H, and K are other data that is irrelevant. The Group field is a primary location, Group2 and Group3 are secondary and tertiary locations. I have already pulled out the data I need for the primary location into Worksheet2 (as shown above). I need to loop through the Group2 and then Group3 columns to find rows that have an existing value. If there is a value in Group2 or Group3, then copy specific cells to the bottom of the list on Worksheet2. The number of rows in Worksheet1 and Worksheet2 is always variable (there will be many future spreadsheets like this).

So - loop through Group2 column, when a value is found, copy the LastName, FirstName, Code, ID, Group2, and Address2 to the bottom of the Worksheet2 list (Group2 and Address2 will now appear in the Group and Address columns). Then do the same for the Group3 column.

The end results will look like this:

Worksheet2
[TABLE="class: ydpf8f6d4a8wysiwyg_dashes, width: 500"]
<tbody>[TR]
[TD]LastName[/TD]
[TD]FirstName[/TD]
[TD]Code[/TD]
[TD]ID[/TD]
[TD]Group[/TD]
[TD]Address[/TD]
[/TR]
[TR]
[TD]Smith[/TD]
[TD]John[/TD]
[TD]01, 03[/TD]
[TD]123456[/TD]
[TD]Place1[/TD]
[TD]123 Main St.[/TD]
[/TR]
[TR]
[TD]Jones[/TD]
[TD]Fred[/TD]
[TD]06[/TD]
[TD]852547[/TD]
[TD]Place1[/TD]
[TD]123 Main St.[/TD]
[/TR]
[TR]
[TD]White[/TD]
[TD]Barb[/TD]
[TD]03, 123, 04[/TD]
[TD]258787[/TD]
[TD]Place1[/TD]
[TD]123 Main St.[/TD]
[/TR]
[TR]
[TD]Collins[/TD]
[TD]Susan[/TD]
[TD]06, 03[/TD]
[TD]345214[/TD]
[TD]Place2[/TD]
[TD]345 Water St.[/TD]
[/TR]
[TR]
[TD]Jones[/TD]
[TD]Fred[/TD]
[TD]06[/TD]
[TD]852547[/TD]
[TD]Place2[/TD]
[TD]345 Water St.[/TD]
[/TR]
[TR]
[TD]White[/TD]
[TD]Barb[/TD]
[TD]03, 123, 04[/TD]
[TD]258787[/TD]
[TD]Place2[/TD]
[TD]345 Water St.[/TD]
[/TR]
[TR]
[TD]Collins[/TD]
[TD]Susan[/TD]
[TD]06, 03[/TD]
[TD]345214[/TD]
[TD]Place4[/TD]
[TD]987 1st St.[/TD]
[/TR]
[TR]
[TD]Jones[/TD]
[TD]Fred[/TD]
[TD]06[/TD]
[TD]852547[/TD]
[TD]Place3[/TD]
[TD]567 High St.[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Thank you for any help you can give me on this!
 

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.
Sort by date Sort by votes
Hi & welcome to MrExcel
How about
Code: 
Sub Copydata()
   Dim lr As Long
   
   With Sheets("sheet1")
      lr = .Range("A" & Rows.count).End(xlUp).row
      .Range("E:E").EntireColumn.Hidden = True
      .Range("A1:G" & lr).SpecialCells(xlVisible).Copy Sheets("sheet2").Range("A1")
      .Range("F:H").EntireColumn.Hidden = True
      .Range("A2:J" & lr).SpecialCells(xlVisible).Copy Sheets("Sheet2").Range("A" & Rows.count).End(xlUp).Offset(1)
      .Range("I:K").EntireColumn.Hidden = True
      .Range("A2:M" & lr).SpecialCells(xlVisible).Copy Sheets("Sheet2").Range("A" & Rows.count).End(xlUp).Offset(1)
      .Range("E:K").EntireColumn.Hidden = False
   End With
   Sheets("Sheet2").Range("F:F").SpecialCells(xlBlanks).EntireRow.Delete
End Sub
 
Upvote 0
Fluff said:
Hi & welcome to MrExcel
How about
Code: 
Sub Copydata()
   Dim lr As Long
   
   With Sheets("sheet1")
      lr = .Range("A" & Rows.count).End(xlUp).row
      .Range("E:E").EntireColumn.Hidden = True
      .Range("A1:G" & lr).SpecialCells(xlVisible).Copy Sheets("sheet2").Range("A1")
      .Range("F:H").EntireColumn.Hidden = True
      .Range("A2:J" & lr).SpecialCells(xlVisible).Copy Sheets("Sheet2").Range("A" & Rows.count).End(xlUp).Offset(1)
      .Range("I:K").EntireColumn.Hidden = True
      .Range("A2:M" & lr).SpecialCells(xlVisible).Copy Sheets("Sheet2").Range("A" & Rows.count).End(xlUp).Offset(1)
      .Range("E:K").EntireColumn.Hidden = False
   End With
   Sheets("Sheet2").Range("F:F").SpecialCells(xlBlanks).EntireRow.Delete
End Sub
Click to expand...


This will do the trick. Thank you so much!
 
Upvote 0
Very nice Fluff

I'm still green with VBA but managed to achieve the goal...

Code: 
Dim lastrow As Long, lastrow1 As Long, erow As Long

'Group2 Look
lastrow = Sheets("Sheet1").Cells(Rows.Count, 9).End(xlUp).Row
    'Group3 Look
    lastrow1 = Sheets("Sheet1").Cells(Rows.Count, 12).End(xlUp).Row
    
    Application.ScreenUpdating = False
        
'1,2,3,4,9,10
For i = 2 To lastrow
    If Sheets("Sheet1").Cells(i, "I").Value <> "" Then
    
    Sheets("Sheet1").Cells(i, 1).Copy
        erow = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    Sheets("Sheet1").Paste Destination:=Sheets("Sheet2").Cells(erow, 1)
    Sheets("Sheet1").Cells(i, 2).Copy
    Sheets("Sheet1").Paste Destination:=Sheets("Sheet2").Cells(erow, 2)
    Sheets("Sheet1").Cells(i, 3).Copy
    Sheets("Sheet1").Paste Destination:=Sheets("Sheet2").Cells(erow, 3)
    Sheets("Sheet1").Cells(i, 4).Copy
    Sheets("Sheet1").Paste Destination:=Sheets("Sheet2").Cells(erow, 4)
    Sheets("Sheet1").Cells(i, 9).Copy
    Sheets("Sheet1").Paste Destination:=Sheets("Sheet2").Cells(erow, 5)
    Sheets("Sheet1").Cells(i, 10).Copy
    Sheets("Sheet1").Paste Destination:=Sheets("Sheet2").Cells(erow, 6)
End If


Next i
        '1,2,3,4,12,13
        For j = 2 To lastrow1
            If Sheets("Sheet1").Cells(j, "L").Value <> "" Then
            
            Sheets("Sheet1").Cells(j, 1).Copy
                erow = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
            Sheets("Sheet1").Paste Destination:=Sheets("Sheet2").Cells(erow, 1)
            Sheets("Sheet1").Cells(j, 2).Copy
            Sheets("Sheet1").Paste Destination:=Sheets("Sheet2").Cells(erow, 2)
            Sheets("Sheet1").Cells(j, 3).Copy
            Sheets("Sheet1").Paste Destination:=Sheets("Sheet2").Cells(erow, 3)
            Sheets("Sheet1").Cells(j, 4).Copy
            Sheets("Sheet1").Paste Destination:=Sheets("Sheet2").Cells(erow, 4)
            Sheets("Sheet1").Cells(j, 12).Copy
            Sheets("Sheet1").Paste Destination:=Sheets("Sheet2").Cells(erow, 5)
            Sheets("Sheet1").Cells(j, 13).Copy
            Sheets("Sheet1").Paste Destination:=Sheets("Sheet2").Cells(erow, 6)
        End If
 
        Next j


Application.CutCopyMode = False


Application.ScreenUpdating = True
 
Upvote 0
You must log in or register to reply here.

Forum statistics

Threads
1,223,896
Messages
6,175,262
Members
452,627
Latest member
KitkatToby

Share this page

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