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.