0

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.

Dirk Reichel
  • 7,989
  • 1
  • 15
  • 31
axstros
  • 3
  • 2
  • Can you attach the screenshot of the sheet? There are better options to achieve what you are trying instead of looping through all the cells. – Techie May 28 '16 at 17:04
  • You don't need VBA to do this. This can be done with in-cell formulas. – trincot May 28 '16 at 18:52
  • Assuming data starts at "A1, try making `ActiveCell.Worksheet.Range("A1").Select` the first line. – Gary Evans May 28 '16 at 22:36
  • Gary, this macro will run after the file exports from an access macro, so it will already be opening in cell A1. Also, the current code runs correctly at this time no matter what the active cell is when it starts. Unless I'm missing something. – axstros May 28 '16 at 23:41

2 Answers2

0

First thing not use select ... you don't need and will became you code slow and will be depende of the cell that is selected.

I didn't see your code in detail, but if you tell that the first time it runs correctly, but not second time ... normally this happens because in the second run the selected cell is different.

How to avoid the problem:

  • First solution: impose the starting cell in the function

    Range("a1").Select ' this is a example

  • Second solution: Put your code independent of the activeCell ou selectedCell. Just maybe only in the start to start the algorithm.

    sheet1.range("A1") ..... (not use select and activeCell in the code)

The first solution put your system always in the same starting conditions. The second solution is independent of the start condition (is better).

0

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

user3598756
  • 28,893
  • 4
  • 18
  • 28
  • That did it. Thank you very much, and I'll definitely be learning from this code. – axstros May 29 '16 at 15:29
  • 1
    Well, this is the kind of coding we all started with, as the "side effect" of using macro recorder. But you must soon learn to move from it, abandoning "Select/Selection", "Activate/Active" and the likes and embrace the fully qualified range reference style. Finally if my answer fulfilled your question please mark it as accepted. Thank you – user3598756 May 29 '16 at 15:56