VBA For while loop help

[Weeble]

Hi! I'm need of abit of help here. Prob taken water over my head.
I'm a really green VBA coder. Been trying to google and youtube for solutions to my problem. Right now I am doing this manualy with abit of coding. But was wondering if there might be a fully automated solution to this.



My 'Blad1'(sheet1) contains a table with this information.

	A	B	C	D	E
City	Order	Barcode	Article	zone
Atlantis	Crystal	OCE
Atlantis	Boat	OCE
Atlantis	Oars	LAN
Atlantis	Clay statue	CRA
Atlantis	Something	LAN
Atlantis	Facepaint	OCE
Atlantis	Plant	OCE
Atlantis	Ocean	OCE
Pluto	Rock 1	LAN
Pluto	Rock 2	LAN
Pluto	Rock 3	LA1
Atlantis	Rock 4	OCE
Pluto	Rock 5	LAN
Pluto	Rock 6	LAN
Pluto	Rock 7	LAN

<tbody>
[TD="align: center"]1[/TD]

[TD="align: center"]2[/TD]

[TD="align: right"]123[/TD]
[TD="align: right"]151612[/TD]

[TD="align: center"]3[/TD]

[TD="align: right"]123[/TD]
[TD="align: right"]151613[/TD]

[TD="align: center"]4[/TD]

[TD="align: right"]123[/TD]
[TD="align: right"]151511[/TD]

[TD="align: center"]5[/TD]

[TD="align: right"]123[/TD]
[TD="align: right"]151234[/TD]

[TD="align: center"]6[/TD]

[TD="align: right"]123[/TD]
[TD="align: right"]151236[/TD]

[TD="align: center"]7[/TD]

[TD="align: right"]123[/TD]
[TD="align: right"]151612[/TD]

[TD="align: center"]8[/TD]

[TD="align: right"]123[/TD]
[TD="align: right"]151612[/TD]

[TD="align: center"]9[/TD]

[TD="align: right"]123[/TD]
[TD="align: right"]151619[/TD]

[TD="align: center"]10[/TD]

[TD="align: right"]321[/TD]
[TD="align: right"]163215[/TD]

[TD="align: center"]11[/TD]

[TD="align: right"]321[/TD]
[TD="align: right"]132168[/TD]

[TD="align: center"]12[/TD]

[TD="align: right"]321[/TD]
[TD="align: right"]133521[/TD]

[TD="align: center"]13[/TD]

[TD="align: right"]321[/TD]
[TD="align: right"]132168[/TD]

[TD="align: center"]14[/TD]

[TD="align: right"]321[/TD]
[TD="align: right"]132168[/TD]

[TD="align: center"]15[/TD]

[TD="align: right"]321[/TD]
[TD="align: right"]132168[/TD]

[TD="align: center"]16[/TD]

[TD="align: right"]321[/TD]
[TD="align: right"]132168[/TD]

</tbody>

Blad1​

My 'Blad2'(sheet2) has this information

	E	F	G	H

<tbody>
[TD="align: center"]2[/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] "]City :[/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] "]Atlantis[/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] , align: right"][/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] , align: right"][/TD]

[TD="align: center"]3[/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] "]Zone[/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] "]OCE[/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] , align: right"][/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] , align: right"][/TD]

[TD="align: center"]4[/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] , align: right"][/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] , align: right"][/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] , align: right"][/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] , align: right"][/TD]

[TD="align: center"]5[/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] "]Unique Barcodes:[/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FF0000]#FF0000[/URL] , align: right"]151612[/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] , align: right"][/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] , align: right"][/TD]

[TD="align: center"]6[/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] , align: right"][/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FF0000]#FF0000[/URL] , align: right"]151613[/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] , align: right"][/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] , align: right"][/TD]

[TD="align: center"]7[/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] , align: right"][/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FF0000]#FF0000[/URL] , align: right"]151619[/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] , align: right"][/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] , align: right"][/TD]

</tbody>

Blad2​

My goal.

I want to have a VBA For While loop that does the following.

1. From 'Blad1' Copy first unique value in column A into 'Blad2' F2(city).
2. Then I want to copy the first unique value from 'Blad1' column E(zone), that matches F2(city) in 'Blad2'F2. into 'Blad2' F3
3. I then want to add a line that prints 'Blad2'
4. Then I need to check if column E in 'Blad1' has another unique value that matches F2(city) from 'Blad2', If so, copy that next value into 'Blad2' F3
5. IF there was a new unique value, print 'Blad2' again.

For looping thrue this, it should now have found.

• City : Atlantis
• Zone: OCE
• Printed

And also copied LAN to Zone

• Printed

And also copied CRA to Zone

• Printed

Next step the FOR loop should not have found any more unique values of ZONES with the city Atlantis.
Then it should continue and look for the next unique CITY name in 'Blad1' which is Pluto.
Then continue the previous loop, but with the new unique value of Pluto.

Maybe this became more complicated then I originaly expected.

 

[JLGWhiz]

The way your scenario reads it would print a full page with a single item for the first loop,
Then, since sheet2 already has that item listed, when you add the second zone data, it would print a full page with only two items of data.
Then, a third item would be added to sheet2 and a full page printed with three items of data.
It seems to me that if you used sheet two to create a list of items similar to the one below.
[TABLE="width: 122"]
<TBODY>[TR]
[TD="class: xl65, width: 81, bgcolor: transparent"]City
[/TD]
[TD="class: xl66, width: 81, bgcolor: transparent"]Zone
[/TD]
[/TR]
[TR]
[TD="class: xl65, width: 81, bgcolor: transparent"]Atlantis
[/TD]
[TD="class: xl65, width: 81, bgcolor: transparent"]OCE
[/TD]
[/TR]
[TR]
[TD="class: xl65, width: 81, bgcolor: transparent"]Atlantis
[/TD]
[TD="class: xl65, width: 81, bgcolor: transparent"]LAN
[/TD]
[/TR]
[TR]
[TD="class: xl65, width: 81, bgcolor: transparent"]Atlantis
[/TD]
[TD="class: xl65, width: 81, bgcolor: transparent"]CRA
[/TD]
[/TR]
[TR]
[TD="class: xl65, width: 81, bgcolor: transparent"]Pluto
[/TD]
[TD="class: xl65, width: 81, bgcolor: transparent"]LAN
[/TD]
[/TR]
[TR]
[TD="class: xl65, width: 81, bgcolor: transparent"]Pluto
[/TD]
[TD="class: xl65, width: 81, bgcolor: transparent"]LA1
[/TD]
[/TR]
</TBODY>[/TABLE]

then you could just print the sheet 1 time and save some paper. But maybe you need the separate sheets. If so, do you want to accumulate the data for each loop, or would you want to delete data from the previous loop and only print data from the current loop?

Also, I note that you have unique barcodes listed in your Blad2 example, but there is no mention of them in the description of what you want to copy from Blad1. Did you inadvertantly omit those from the copy requirement?

 

[Weeble]

Sorry for the late late reply JLG, I ran into a whole bunch of problem with other stuff that held me back for a while.
I'll try and explain what 'Blad2' is used for. I : M generates a list from 'Blad1' depending on that F2 and F3 has.
The Barcodes is also data from 'Blad1' Table. So this loop is to go thrue all The Cities with their respective zones, and print a sheet of paper for each zone. In 'Blad2'.

	E	F	G	H	I	J	K	L	M
Atlantis	Crystal	OCE
Atlantis	Boat	OCE
Atlantis	Facepaint	OCE
Atlantis	Plant	OCE
Atlantis	Ocean	OCE
Atlantis	Rock 4	OCE

<colgroup><col style="width: 25pxpx"><col><col><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
[TD="align: center"]2[/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] "]City : [/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] "]Atlantis[/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] , align: right"][/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] , align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]3[/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] "]Zone[/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] "]OCE[/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] , align: right"][/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] , align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]4[/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] , align: right"][/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] , align: right"][/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] , align: right"][/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] , align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]5[/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] "]Unique Barcodes:[/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FF0000]#FF0000[/URL] , align: right"]151612[/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] , align: right"][/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] , align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]6[/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] , align: right"][/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FF0000]#FF0000[/URL] , align: right"]151613[/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] , align: right"][/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] , align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]7[/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] , align: right"][/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FF0000]#FF0000[/URL] , align: right"]151619[/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] , align: right"][/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] , align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]8[/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] , align: right"][/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FF0000]#FF0000[/URL] , align: right"]132168[/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] , align: right"][/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFC000]#FFC000[/URL] "]List:[/TD]

[TD="align: right"]123[/TD]
[TD="align: right"]151612[/TD]

[TD="align: center"]9[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: right"]123[/TD]
[TD="align: right"]151613[/TD]

[TD="align: center"]10[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: right"]123[/TD]
[TD="align: right"]151612[/TD]

[TD="align: center"]11[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: right"]123[/TD]
[TD="align: right"]151612[/TD]

[TD="align: center"]12[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: right"]123[/TD]
[TD="align: right"]151619[/TD]

[TD="align: center"]13[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: right"]321[/TD]
[TD="align: right"]132168[/TD]

</tbody>

Blad2​

 

[JLGWhiz]

From your explaination in Post #3 , I assume that Blad 2 has formulas beginning in row 5 of Column F and in Columns I:M which will use the values in F2 and F3 to populate the applicable cells with data.

Sub t()
Dim i As Long, r As Range, fn As Range, c As Range
With Sheets("Sheet1")
    .Range("A1", .Cells(Rows.Count, 1).End(xlUp)).AdvancedFilter xlFilterCopy, , .Cells(Rows.Count, 1).End(xlUp)(3), True
    .Range("E1", .Cells(Rows.Count, 5).End(xlUp)).AdvancedFilter xlFilterCopy, , .Cells(Rows.Count, 5).End(xlUp)(3), True
    For Each c In .Cells(Rows.Count, 1).End(xlUp).CurrentRegion.Offset(1)
        If c <> "" Then
            For Each r In .Cells(Rows.Count, 5).End(xlUp).CurrentRegion.Offset(1)
                If r <> "" Then
                    Set fn = .Range("E:E").Find(r.Value, , xlValues)
                        If Not fn Is Nothing Then
                            If fn.Offset(, -4) = c.Value Then
                                With Sheets("Sheet2")
                                    .Range("F2:F3").ClearContents
                                    .Range("F2") = c.Value
                                    .Range("F3") = r.Value
                                    Sheets("Sheet2").PrintOut
                                End With
                            End If
                        End If
                End If
            Next
        End If
    Next
    .Cells(Rows.Count, 1).End(xlUp).CurrentRegion.ClearContents
    .Cells(Rows.Count, 5).End(xlUp).CurrentRegion.ClearContents
End With
End Sub

 

[JLGWhiz]

Use this instead. I inadvertantly left out a loop to ensure all combinations were checked.

Sub t2()
Dim i As Long, r As Range, fn As Range, c As Range, adr As String
With Sheets("Sheet1")
    .Range("A1", .Cells(Rows.Count, 1).End(xlUp)).AdvancedFilter xlFilterCopy, , .Cells(Rows.Count, 1).End(xlUp)(3), True
    .Range("E1", .Cells(Rows.Count, 5).End(xlUp)).AdvancedFilter xlFilterCopy, , .Cells(Rows.Count, 5).End(xlUp)(3), True
    For Each c In .Cells(Rows.Count, 1).End(xlUp).CurrentRegion.Offset(1)
        If c <> "" Then
            For Each r In .Cells(Rows.Count, 5).End(xlUp).CurrentRegion.Offset(1)
                If r <> "" Then
                    Set fn = .Range("E:E").Find(r.Value, , xlValues)
                        If Not fn Is Nothing Then
                            adr = fn.Address
                            Do
                                If fn.Offset(, -4) = c.Value Then
                                    With Sheets("Sheet2")
                                        .Range("F2:F3").ClearContents
                                        .Range("F2") = c.Value
                                        .Range("F3") = r.Value
                                        Sheets("Sheet2").PrintOut
                                    End With
                                    Exit Do
                                End If
                                Set fn = .Range("E:E").FindNext(fn)
                            Loop While adr <> fn.Address
                        End If
                End If
            Next
        End If
    Next
    .Cells(Rows.Count, 1).End(xlUp).CurrentRegion.ClearContents
    .Cells(Rows.Count, 5).End(xlUp).CurrentRegion.ClearContents
End With
End Sub