Copy one column, but loop through a second column multiple times depending on first column

Hi VBA Gurus,

I have a VBA programming project that I’ve been working on but just can’t seem to solve. Suppose I have this toy worksheet:

Diagram 0.jpg

Column B has a list of girls, Column C has a list of chores and, between #ALL_GIRLS tags, there are some cells which will be copied later. My code must read through Column C, copying its contents to Column D. But once it encounters an opening #ALL_GIRLS tag, it has to stop and for each girl listed in Column B, it has to copy the between-tags cells, substituting a girl’s name for the “XXXXX” placeholder:

Diagram 1.jpg

(The highlighting is not necessary, I’m just using it to, well, highlight the altered text.) Also, note that the #ALL_GIRLS tags are not copied.

The #ALL_GIRLS tags may appear multiple times and anywhere in Column C:

Diagram 2.jpg

Again, the highlighting is just to illustrate the altered text between Columns C and D.

Some other minor notes: The girls will always be listed starting at $B$2, and there will always be at least one girl. Columns C and D will always start at $C$2, and $D$2, respectively. We can assume Columns B and C will never grow past 100 cells, but Column D might be very, very long, depending on how many #ALL_GIRLS tags there are.

Here’s what I have:

Sub ChoresList()
    Application.ScreenUpdating = False
    Dim lastGirl As Long, lastStatement As Long, statement As Range
    Dim checkStr As Integer, dIndex As Integer
    dIndex = 2      ' We start copying cells to Column D starting at D2
    
    ' I take some measurements...
    lastGirl = WorksheetFunction.CountA(Range("B2:B101"))
    ' So the girls range from "B2" to "B"&(lastGirl+1)
    lastStatement = WorksheetFunction.CountA(Range("C2:C101"))
    ' So the Col C statements range from "C2" to "C"&(lastStatement+1)
    
    For Each statement In Range("C2:C" & (lastStatement + 1))
        checkStr = InStr(x, "#ALL_GIRLS")
        If checkStr > 0 Then
            ' We've reached a #ALL_GIRLS tag
            For Each girl In Range("B2:B" & (lastGirl + 1))
            ' Cycle through each girl here, coying over the non-#ALL_GIRLS lines
            Next girl
        Else
            ' Non-tagged line; just copy it to Column D
            Range("D" & dIndex) = statement
        End If
        dIndex = dIndex + 1
    Next statement
    Application.ScreenUpdating = True
End Sub

Obviously, this comes no-where near close to getting the job done, and I’m really stuck in the middle of that “If checkStr > 0” loop. (I do have code for this part, but it works very poorly and is far too long to post.) I’m clearly in over my head.

Can anyone recommend a better approach? There’s got to be a succinct way of doing this in one on-the-fly pass through Column C. (I am using Excel 2019)

FULL DISCLOSURE: I posted a similar problem on this forum, which I’d hoped would give me enough help to crack this problem. (Unfortunately, I am forbidden to post the link.) But my code gets tripped up with the tags and the copying, and I realized I needed to repost my problem, this time with more specifics.

Wow, thanks Sintek,

I'm about to try your code, it looks great.

Because I'm a new member of the forum, I'm forbidden to post URLs. So I can tell you the previous post was: excelforum.com ...and then... excel-programming-vba-macros/1288921-loop-through-two-data-ranges-at-the-same-time.html#post5189223

Sorry, you'll have to remove the spaces I added to pull up the link.

Thanks!

Yes! This worked great! I just stress-tested your code with my "real" data - 100 girls, 100 tasks, with 35+ #ALL_GIRLS tags embedded within the data. Then verified the results. It works awesome!

My solutions were over 200 lines in code and kept inviting bugs. Your code is shorter than my variable declaration section! You also use a lot of functions I've never used before, but will look up and add them to my toolbelt. I always learn so much when someone like you takes the time to show me their code.

Thanks, I owe you one!