Excel VBA - Is it possible to increment index across multiple sheets? (incrementing one row at a time, indexing one row from each sheet)

Question

I have 4 sheets and a data sheet in another workbook. I want to increment numbers for index for every row I am retrieving from in the 4 sheets as you can see in the pictures I have inserted. (incrementing the index one row at a time, indexing one row from each sheet in sequence) This is my code which can only increment rows within sheet.

    Sub IncrementIndexesAcrossSheets()
    Dim ws As Worksheet
    Dim dataRange As Range
    Dim rowIndex As Long
    Dim lastRowIndex As Long
    
    ' Initialize rowIndex to 1
    rowIndex = 1
    
    ' Loop through all sheets in the workbook
    For Each ws In ThisWorkbook.Sheets
        ' Skip sheets without data
        If WorksheetFunction.CountA(ws.Cells) > 0 Then
            ' Set the dataRange to the appropriate column (Column B in this case)
            Set dataRange = ws.Range("B2:B" & ws.Cells(Rows.Count, 2).End(xlUp).Row)
            
            ' Loop through each cell in the dataRange
            For Each cell In dataRange
                ' Set the value of the Index column (Column A) to the current rowIndex
                cell.Offset(0, -1).Value = rowIndex
                ' Increment the rowIndex
                rowIndex = rowIndex + 1
            Next cell
            
            ' Update lastRowIndex with the last used index on the current sheet
            lastRowIndex = rowIndex - 1
        End If
    Next ws
End Sub

This is the sample data:

This is the output I want: Sheet1:

Sheet2:

Sheet3:

Sheet4:

I am new to VBA and I have tried searching for multiple solutions but all came down to either incrementing within the sheet or just in a cell across multiple sheets. Please do help as I would really like to learn how to code such a task in VBA. My previous question was closed so I am opening a new one with better clarity.

Answer 1

I'm sure there's a less convoluted way of doing this but here's my attempt, not taking in account your manual editing that has no logic behind the row numbers.

This checks what the total amount of rowindexes is and iterates over the (useful) sheets until the total amount of rows is reached.

Sub IncrementIndexesAcrossSheets()
    Dim ws As Worksheet, shIndex As Long, totalShts As Long
    Dim rowIndex As Long, totalRows As Long, lRow As Long
    Dim dict As Object
    
    With ThisWorkbook
        totalShts = .Sheets.Count
        Set dict = CreateObject("Scripting.Dictionary")
        ' Loop through all sheets in the workbook
        For Each ws In .Sheets
            shIndex = shIndex + 1
            ' Skip sheets without data
            If WorksheetFunction.CountA(ws.Cells) > 0 Then
                ' Set the dataRange to the appropriate column (Column B in this case)
                totalRows = totalRows + ws.Cells(Rows.Count, 2).End(xlUp).Row - 1 'taking account for headers
            End If
            dict(shIndex) = shIndex 'adding the sheet indexes to a dictionary to keep track which ones
                                    'are to be used without having to recheck
        Next ws
        shIndex = 1
        Do While rowIndex < totalRows
            If Not dict.Exists(shIndex) Then 'Don't want to accidentally add it with that weird dictionary "bug"
            Else
                With .Sheets(shIndex)
                    lRow = .Range("A" & Rows.Count).End(xlUp).Row
                    If .Range("A" & lRow).Offset(1, 1) <> "" Then
                        rowIndex = rowIndex + 1
                        .Range("A" & lRow).Offset(1).Value = rowIndex
                    Else
                        dict.Remove shIndex 'sheet is all filled out
                    End If
                End With
            End If
            shIndex = shIndex + 1
            If shIndex > totalShts Then shIndex = 1 'don't go over the Sheets.Count
        Loop
    End With
End Sub

If there's actually any concrete logic for it to be 4-> 7 on sheet4, I'll try to implement it.

Edit: After some back and forth with OP, got some logic to implement the continuation on sheet4 before going back to its original order with the distribution number:

Sub IncrementIndexesAcrossSheets()
    Dim ws As Worksheet, shIndex As Long, totalShts As Long
    Dim rowIndex As Long, totalRows As Long, lRow As Long
    Dim dict As Object
    Dim distriNum
    
    With ThisWorkbook
        totalShts = .Sheets.Count
        Set dict = CreateObject("Scripting.Dictionary")
        ' Loop through all sheets in the workbook
        For Each ws In .Sheets
            shIndex = shIndex + 1
            ' Skip sheets without data
            If WorksheetFunction.CountA(ws.Cells) > 0 Then
                ' Set the dataRange to the appropriate column (Column B in this case)
                totalRows = totalRows + ws.Cells(Rows.Count, 2).End(xlUp).Row - 1 'taking account for headers
            End If
            distriNum = Application.Match("Distribution Number*", ws.Rows(1), 0)
            If IsError(distriNum) Then distriNum = 0 'If it is 0 = no Distribution Number, otherwise column number
            dict(shIndex) = distriNum 'adding the sheet indexes to a dictionary to keep track which ones
                                    'are to be used without having to recheck
        Next ws
        shIndex = 1
        Do While rowIndex < totalRows
            If Not dict.Exists(shIndex) Then 'Don't want to accidentally add it with that weird dictionary "bug"
            Else
                With .Sheets(shIndex)
                    lRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
                    distriNum = dict(shIndex)
                    If .Range("A" & lRow).Offset(0, 1) <> "" Then
                        Do While distriNum > -1
                            rowIndex = rowIndex + 1
                            .Range("A" & lRow).Value = rowIndex
                            If distriNum = 0 Then
                                distriNum = -1
                            ElseIf .Cells(lRow + 1, distriNum).Value = 1 Or .Cells(lRow + 1, distriNum).Value = "" Then
                                distriNum = -1
                            Else
                                lRow = lRow + 1
                            End If
                        Loop
                    Else
                        dict.Remove shIndex 'sheet is all filled out
                    End If
                End With
            End If
            shIndex = shIndex + 1
            If shIndex > totalShts Then shIndex = 1 'don't go over the Sheets.Count
        Loop
    End With
End Sub

This will now check if there's a column with "Distribution Number" in the sheet and continue on said sheet until the next distribution number changes back to 1 and moves forward from there. Used the pre-existing dictionary to pass along the possible column number for the distribution logic.