Solved: loop in a loop

[JayJay6]

Hi,
I really need som help with this:
I have a spreadsheet where I need to make a list from the following setup:

Spreadsheet 1:

column 1, column 2
FirstName, FirstName1
LastName, LastName1
Address, Address1
zip, zip1
FirstName, FirstName2
MiddleName, MiddleName2 (!!)
LastName, LastName2
Address, Address2
zip, zip2
FirstName, FirstName3
LastName, LastName3
Address, Address3
zip, zip3

From this setup, I need to extract the following on a separate spreadsheet:

Spreadsheet 2:

Column1, Column2
FirstName1, Address1
FirstName2, Address2
FirstName3, Address3

I am not that experienced in VBA programming, but as I see it I need to make a loop(Address) in a loop(Name) and somehow export the relevant cellvalues to Spreadsheet 2.
Can anyone please give me a hand in solving this?

thanks.
BR,
Jakob

[Bob Phillips]

Public Sub ProcessData()
Dim sh As Worksheet
Dim Lastrow As Long
Dim Nextrow As Long
Dim i As Long

Application.ScreenUpdating = False

Set sh = Worksheets("Sheet2")

With Worksheets("Sheet1")

Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 1 To Lastrow 'Lastrow to 1 Step -1

If .Cells(i, "A").Value2 = "FirstName" Then

Nextrow = Nextrow + 1
.Cells(i, "B").Copy sh.Cells(Nextrow, "A")
.Cells(i + 1, "B").Copy sh.Cells(Nextrow, "B")
End If
Next i
End With

Application.ScreenUpdating = True
End Sub

[JayJay6]

Hi Xld,
Brilliant! However: as you may notice on my list, there will be some fields (here illustrated with the "MiddleName2") which only figures in some of the records. Therefore: is it possible to track the cellnames "FirstName" and the related "Address" in column 1, no matter position ?

Br,
Jakob

[Bob Phillips]

Oops! I did notice that, then ignored it.



Public Sub ProcessData()
Dim sh As Worksheet
Dim Lastrow As Long
Dim Nextrow As Long
Dim i As Long

Application.ScreenUpdating = False

Set sh = Worksheets("Sheet2")

With Worksheets("Sheet1")

Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 1 To Lastrow

If .Cells(i, "A").Value2 = "FirstName" Then

Nextrow = Nextrow + 1
.Cells(i, "B").Copy sh.Cells(Nextrow, "A")
ElseIf .Cells(i, "A").Value2 = "Address" Then

.Cells(i, "B").Copy sh.Cells(Nextrow, "B")
End If
Next i
End With

Application.ScreenUpdating = True
End Sub

[JayJay6]

Excellent!!! Thanks a lot.:content:

Br,
Jakob

[JayJay6]

One last question: When I run the script, using a commandbutton, it won't stop until I reset the macro manually. Is it possible to stop/reset the script in the end, so it is ready to run next time I hit the commandbutton ?
Br,
Jakob[/quote]

[Bob Phillips]

Don't understand what you mean by won't stop.

[Bob Phillips]

Don't understand what you mean by won't stop.

[JayJay6]

no worries. I've got it working. Appologies!

Thanks.

Br,
Jakob

[JayJay6]

Hi Xld,

One final question:
In your script, is it possible to make the list generated in "worksheet2" start in row 2 (-in order to make a column heading on each column) ?

thanks.

Br,
Jakob

[Bob Phillips]

Yeah, add a line

Nextrow = 1

before the loop starts.