I cleaned up some extracted data from PDF files as much as possible and this is an example of what I have now in Sheet1:

This is what I’m trying to get in Sheet2:

This is the code I have so far. It only works for the first overall loop + finding the location where the second date would go in Sheet2. The values in Sheet2 all start from row 6. First the code looks for the first non-empty cell in the Date column in Sheet1, then assigns the value of that cell to the cell A6 in Sheet2. Then it looks for the respective StoreA and StoreB values and assigns them correspondingly in their columns in Sheet2. At the end it looks for the last used row within the B:C range, and finds the value where the next Date value would go in in column A. What I’m trying to do is to then call the Date loop again so that it looks for the date, and then for the next corresponding Store values, and so on.

I understand that the issue is that by calling the functions recursively I’m re-setting the variable back to the original location/value which is causing an infinite loop instead of “starting from where the last loop left off”, but I’m not sure how I can assign the first static location to the first value and then assign the dynamic cell locations to the following cases. The solution seems really simple but I really don’t know what it is. I think the Range.Find method might be what I’m looking for but afaik it would simply go through the entire column range at once, whereas what I need is more of a nested loop(?), as the location of the next date in Sheet2 is dependant on the number of rows used by the values range of the previous day.

Option Explicit

Sub setDateValues()

    Dim ws2 As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim beginnerCell As Range
    Dim nextEmptyDateCell As Range
   
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    
   'set range for column B
    Set rng = ThisWorkbook.Sheets("Sheet1").Range("B2:B" & _
                     ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Row)
                                                  
                                                  
   'set initial cell for beginnerCell / alternatively 
    'simply “A6”? I think this variable might only be needed 
    'for the first loop, or maybe I can re-set it to the last cell in the loop?
    Set beginnerCell = ws2.Cells(Rows.Count, "A").End(xlUp).Offset(5, 0) 
    

   'loop through column B range; find next non-empty cell and attribute cell value
   'to beginnerCell in Sheet2
    For Each cell In rng
        If Not IsEmpty(cell.Value) Then
            beginnerCell.Value = cell.Value
           cell = beginnerCell
            Exit For
        End If
    Next cell

    Dim LastRow As Long
    
    'find last used row within B:C range
    LastRow = WorksheetFunction.Max(ws2.Cells(ws2.Rows.Count, "B").End(xlUp).Row, _
                                    ws2.Cells(ws2.Rows.Count, "C").End(xlUp).Row)

   're-set beginnerCell  as two cells below that row, in column 1
    Set beginnerCell = ws2.Cells(LastRow + 2, "A")
    

      
    Dim nextCellStoreA As Range
    Dim nextCellStoreB As Range


   'set range for column A to loop through
    Set rng = ThisWorkbook.Sheets("Sheet1").Range("A2:A" & _
    ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row)
    
    'set initial cell for nextCellStoreA 
    Set nextCellStoreA = ws2.Cells(Rows.Count, "B").End(xlUp).Offset(5, 0)
    
    'set initial cell for nextCellStoreB 
    Set nextCellStoreB = ws2.Cells(Rows.Count, "C").End(xlUp).Offset(5, 0)
    
    'same issue as in the first loop; the loop starts from the beginning again, 
    'maybe I could create a variable that stores the address of the last cell?
    
    'loop through Sheet1!ColumnA range and assign values in Sheet2
    For Each cell In rng
        If cell.Value = "StoreB" Then
            nextCellStoreB.Value = cell.Offset(, 2).Value
            Set nextCellStoreB = nextCellStoreB.Offset(1, 0)

            ElseIf cell.Value = "StoreA" Then
            nextCellStoreA.Value = cell.Offset(, 2).Value
            Set nextCellStoreA = nextCellStoreA.Offset(1, 0)

        End If
                    If cell.Value = "." Then Exit For
    Next cell

End Sub