Loop through list and find all additional criteria, then add below.

RockandGrohl

Well-known Member
Joined
Aug 1, 2018
Messages
801
Office Version
  1. 365
Platform
  1. Windows
Hello,

Have a situation developing here.

There is one sheet "CT" which has a list of products and the dates next to them.

The list is incomplete and I need to fill criteria from another sheet, "PP"

This is what I have so far.

Code:
Dim Lastrow As Long, Row As Long



Set ct = Worksheets("Campaign TourRefs")


Set pp = Workbooks.Open("H:\Sales\Price Panels\Price Panels 2019.xlsm", ReadOnly:=True)
Range("A3").Activate
ct.Activate




Range("A3").Activate


Do Until Cells(ActiveCell.Row, "A").Value = ""
    MLTOUR = Cells(ActiveCell.Row, "A").Value
    MLDATE = Cells(ActiveCell.Row, "B").Value
    Row = Cells(ActiveCell.Row)
    pp.Activate
        Do Until Cells(ActiveCell.Row, "A").Value = ""
        If Cells(ActiveCell.Row, "A").Value <> MLTOUR Then
        ActiveCell.Offset(1, 0).Activate
        Else
        PPNAME = Cells(ActiveCell.Row, "C").Value
            Do Until Cells(ActiveCell.Row, "A").Value = ""
            If Cells(ActiveCell.Row, "C").Value = PPNAME And Cells(ActiveCell.Row, "M").Value = MLDATE And Cells(ActiveCell.Row, "K").Value = "Megacoach" Then
            PPTOUR = Cells(ActiveCell.Row, "A").Value
            ct.Activate
            Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
            Range("A" & Lastrow + 1).Activate
            Cells(ActiveCell.Row, "A").Value = PPTOUR
            Cells(ActiveCell.Row, "B").Value = MLDATE
            pp.Activate
            Else
            ActiveCell.Offset(1, 0).Activate
            
            
            End If
            ActiveCell.Offset(1, 0).Activate
            Loop
        
        End If
        Loop


ct.Activate
Range("A" & Row + 1).Activate
ActiveCell.Offset(1, 0).Activate
Loop

What I need to do:

In CT, the table is laid out with a list of products in column A and a list of dates in col. B

I need to select the first product in cell A3, hold that and the date as a variable (MLTOUR and MLDATE)

Then switch to PP, and start a loop going from top to bottom until I run out of rows of data.

When I find a value in column A that matches the MLTOUR, it needs to hold the NAME of the product as PPNAME. Then, I need to loop down from that point within PP until I find a row that fits the following 3 critera:
  • MLTOUR is matched in Column C
  • MLDATE is matched in Column M
  • Column K value is "Megacoach"

From here, I need to set the value in that row, column A as "PPTOUR"

Once that is set, switch back to CT, jump to the bottom and then place "PPTOUR" and "MLDATE" in columns A and B respectively, then, return back to the same row I was on before, jump down one, then repeat the whole process.

WHEW!

So essentially I'm looking up in PP a series of criteria then appending the data in CT. The critical part is that it needs to stop once I've exhausted the list - this is a problem if I'm appending data constantly because if my original list is 20 long and I append another 50, it will want to look through 70 items, even though it should look at 20.

I've never used it before so I need help, but would "For x" help? Where I tell VBA there's 20 lines so when you get to line 21, stop?

Thank you.
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
I solved this all by myself.

I was running into issues because, like a sperg, I seem to ignore my own best advice of "If you open a loop, close it immediately and then go back and fill in what you want the loop to do"

As a result I had a tangled mess that I couldn't mentally untangle.

I also set up two more Long's - one was Workload - this calculated how many rows I had initially and I changed my Do Until to simply stop when it reaches the end of the workload.

The other piece of logic was to record the "row" I am checking PP against, and then once I have appended the list, to return to that row + 1 to get to the next item.

Here's the new working code:

Code:
Range("A3").Activate

workload = Cells(Rows.Count, "A").End(xlUp).Row - 2




Do Until ActiveCell.Row = workload + 3
    MLTOUR = Cells(ActiveCell.Row, "A").Value
    MLDATE = Cells(ActiveCell.Row, "B").Value
    Row = ActiveCell.Row
    pp.Activate
    Range("A3").Activate
        Do Until Cells(ActiveCell.Row, "A").Value = ""
        If Cells(ActiveCell.Row, "A").Value <> MLTOUR Then
        ActiveCell.Offset(1, 0).Activate
        Else
        PPNAME = Cells(ActiveCell.Row, "C").Value
            Do Until Cells(ActiveCell.Row, "A").Value = ""
            If Cells(ActiveCell.Row, "C").Value = PPNAME And Cells(ActiveCell.Row, "M").Value = MLDATE And Cells(ActiveCell.Row, "K").Value = "Megacoach" And Cells(ActiveCell.Row, "B").Value <> "Cancelled" Then
            PPTOUR = Cells(ActiveCell.Row, "A").Value
            ct.Activate
            Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
            Range("A" & Lastrow + 1).Activate
            Cells(ActiveCell.Row, "A").Value = PPTOUR
            Cells(ActiveCell.Row, "B").Value = MLDATE
            pp.Activate
            Else
            
            
            End If
            ActiveCell.Offset(1, 0).Activate
            Loop
        
        End If
        Loop


ct.Activate
Range("A" & Row + 1).Activate
Loop
    


    Columns("A:B").Select
    ActiveSheet.Range("A:B").RemoveDuplicates Columns:=Array(1, 2), _
        Header:=xlNo


pp.Close False




Application.ScreenUpdating = True
 
Upvote 0

Forum statistics

Threads
1,223,231
Messages
6,170,884
Members
452,364
Latest member
springate

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