Excel "Do While" Loop Not functioning correctly after first iteration

Question

I have a Sub that does some light formatting, and then I need it to evaluate and count whether a column contains a "1" or nothing, and if that column has a header that isNumeric or not.

First iteration of the Do...Until loops functions exactly as it should. However, if I try to run it a second time, it throws the active cell all the way to the rightmost column in the worksheet (XFD). I have a total of about 114,000 rows that I need this to loop through.

Please see code below, with only the first loop; this will need to be nested inside another loop for cycling through all rows:

Sub TotalBookCountsProcess()

    Dim ws As Excel.Worksheet
    Dim numberedBooks As Integer 'Total Number of physical books
    Dim virtualBooks As Integer 'Total Number of virtual books
    Dim firstBookCol As Integer 'First Column with a book number
    Dim ispeecCol As Integer 'ISPEC Column
    Dim lastWorksheetCol As Integer 'Last Column in the worksheet after adding total book count columns
    Dim loopColOffset As Integer  'Offset column amounts for new row reset after loop
    Dim lastItem As String 'Last item number in last row of the worksheet

    ActiveCell.End(xlDown).Select
    lastItem = ActiveCell.Value
    ActiveCell.End(xlUp).End(xlToRight).Select
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = "Total Numbered Books"
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = "Total CS Books"
    lastWorksheetCol = ActiveCell.Column

    Columns.AutoFit

    numberedBooks = 0
    virtualBooks = 0

    Cells.Range("1:1").Find("ISPEC").Select

    ispecCol = ActiveCell.Column
    firstBookCol = ispecCol + 1
    ActiveCell.Offset(1, 1).Select

    loopColOffset = ((lastWorksheetCol - firstBookCol) * -1)

Do Until ActiveCell.End(xlUp).Value = "Total Numbered Books"
    If ActiveCell.Value = 1 And IsNumeric(ActiveCell.End(xlUp).Value) = True Then
        numberedBooks = numberedBooks + 1
        ActiveCell.Offset(0, 1).Select
    ElseIf ActiveCell.Value = 1 And IsNumeric(ActiveCell.End(xlUp).Value) = False Then
        virtualBooks = virtualBooks + 1
        ActiveCell.Offset(0, 1).Select
    Else
        ActiveCell.Offset(0, 1).Select
    End If
Loop

    ActiveCell.Value = numberedBooks
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = virtualBooks
    ActiveCell.Offset(1, loopColOffset).Select



End Sub

Any insights very much appreciated.

Answer 1

the reason lies in

ActiveCell.End(xlUp).Value = "Total Numbered Books"

as the ending condition of the loop

your real goal was to end the row loop as soon as the ActiveCell column is the one with "Total Numbered Books" value in its first row

but

• ActiveCell.End(xlUp).Value would refer to the FIRST non empty cell above ActiveCell

• from the second iteration on, the cell whose column first row value is actually "Total Numbered Books" also has the cell right above itself filled with numberedBooks value

• so it keeps skipping to the next column till the end of columns...

your code could then be like follows:

Option Explicit

Sub TotalBookCountsProcess()

    Dim ws As Excel.Worksheet
    Dim numberedBooks As Integer 'Total Number of physical books
    Dim virtualBooks As Integer 'Total Number of virtual books
    Dim firstBookCol As Integer 'First Column with a book number
    Dim ispeecCol As Integer 'ISPEC Column
    Dim lastWorksheetCol As Integer 'Last Column in the worksheet after adding total book count columns
    Dim loopColOffset As Integer  'Offset column amounts for new row reset after loop
    Dim lastItem As String 'Last item number in last row of the worksheet
    Dim ispecCol As Long

    ActiveCell.End(xlDown).Select
    lastItem = ActiveCell.Value
    ActiveCell.End(xlUp).End(xlToRight).Select
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = "Total Numbered Books"
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = "Total CS Books"
    lastWorksheetCol = ActiveCell.Column

    Columns.AutoFit

    numberedBooks = 0
    virtualBooks = 0

    Cells.Range("1:1").Find("ISPEC").Select

    ispecCol = ActiveCell.Column
    firstBookCol = ispecCol + 1
    ActiveCell.Offset(1, 1).Select

    loopColOffset = ((lastWorksheetCol - firstBookCol) * -1)

Do
    numberedBooks = 0
    virtualBooks = 0
    Do Until Cells(1, ActiveCell.Column) = "Total Numbered Books"
        If ActiveCell.Value = 1 Then
            If IsNumeric(Cells(1, ActiveCell.Column)) Then
                numberedBooks = numberedBooks + 1
            Else
                virtualBooks = virtualBooks + 1
            End If
        End If
        ActiveCell.Offset(0, 1).Select
    Loop

    ActiveCell.Value = numberedBooks
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = virtualBooks
    ActiveCell.Offset(1, loopColOffset).Select
Loop Until Cells(ActiveCell.Row - 1, 1) = lastItem


End Sub

where I also added the rows loop

but be sure the real solution is avoiding all those selecting/activating