Computer Choking on Simple Code. What am i missing?

user_13773156 0
Viewed 56

This macro searches col B for "check" numbers (IsNumeric) and when found offsets the numbers by (0,2) then replaces the number in the original cell with "check".

When using the lastrow as a rule it runs super slow (albeit just as slow if I were to make the range an entire column i.e. "B:B").

The only difference between the 2 different approaches is that the lastrow rule adds "Checks" to the last row all the way down the column to the sheet's last row. I've been hacking all day and usually something like this doesn't throw me for a loop (pun intended).

Sub Move_Checks()
    
    Dim ws1 As Worksheet
    Set ws1 = Sheets("Combined")
   
   Dim lastrow As Long
     lastrow = Cells(Rows.Count, "a").End(xlUp).row
    
   Dim rng1 As Range
    Set rng1 = Range("B:B") 
    
    Dim Cell As Range
    Set Cell = Range("B2" & lastrow)
    
            For Each Cell In rng1
               If IsNumeric(Cell.value) = True Then
                  Cell.Offset(0, 3) = Cell.value
                            
            End If
                        
        Next Cell
     
            For Each Cell In rng1
             If IsNumeric(Cell.value) = True Then
                 Cell.value = "Check"
    
            End If
    
        Next Cell


End Sub
vba excel loops performance
2 Answers

Try this revised code.

You didn't need two loops, you can make the changes in one go.

Your rng1 variable was set to be the entire column B.

You were nearly setting the Cell variable to actually be the correct Range, but then overriding it by using it as the placeholder for each cell when cycling through the Range.

Sub Move_Checks()
    
    Dim ws1 As Worksheet
    Dim rng1 As Range
    Dim Cell As Range
    Dim lastrow As Long

    Set ws1 = Sheets("Combined")

    lastrow = ws1.Cells(Rows.Count, "a").End(xlUp).row

    Set rng1 = Range("B2:B" & lastrow)
    
    For Each Cell In rng1
        If IsNumeric(Cell.value) = True Then
            Cell.Offset(0, 3) = Cell.value
            Cell.value = "Check"            
        End If               
    Next Cell
     
End Sub
user_64806580

Lookup With Criteria Replace

  • Copy the code into a standard module (e.g. Module1).
  • Adjust the values in the constants section including the workbook.
    • Take especially care of the Target Column TargetCol, the column where the numeric values will be written to, because it was only implicitly mentioned via the 2 or 3 column offset.
    • If you will run this code to apply changes to another workbook, change ThisWorkbook appropriately. ThisWorkbook 'means' the workbook containing this code.
    • The columns are declared as Variant to be able to use either strings or numbers to refer to them i.e. you can use 1 or "A", 2 or "B" ... etc.
  • The Find method is used to define the last cell since End(xlUp) becomes unreliable when hiding and filtering rows.
  • The arrays are used to stop the choking.

The Code

Option Explicit

Sub Move_Checks()
    
    ' Constants
    Const SheetName As String = "Combined"
    Const FirstRow As Long = 2
    Const LastRowCol As Variant = "A" ' e.g. 1 or "A"
    Const SourceCol As Variant = "B"
    Const TargetCol As Variant = "D"
    Const Criteria As String = "Check"
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    ' Write values from Source Column Range to Source Array.
    Dim ws As Worksheet: Set ws = wb.Worksheets(SheetName)
    Dim rng As Range
    Set rng = ws.Columns(LastRowCol).Find("*", , xlValues, , , xlPrevious)
    If rng Is Nothing Then Exit Sub
    If rng.Row < FirstRow Then Exit Sub
    Set rng = ws.Range(ws.Cells(FirstRow, SourceCol), _
                       ws.Cells(rng.Row, SourceCol))
    Dim Source As Variant: Source = rng.Value
    
    ' Write values from Target Column Range to Target Array.
    Dim ColOff As Long: ColOff = ws.Columns(TargetCol).Column - rng.Column
    Dim Target As Variant
    Target = rng.Offset(, ColOff)
    
    ' Modify values in the Arrays.
    Dim i As Long
    For i = 1 To UBound(Source)
        If IsNumeric(Source(i, 1)) Then
            Target(i, 1) = Source(i, 1)
            Source(i, 1) = Criteria
        End If
    Next i
    
    ' Write modified values of the Arrays back to the Ranges.
    rng.Value = Source
    rng.Offset(, ColOff).Value = Target
    
    ' Inform user.
    MsgBox "Done"
  
End Sub
user_98140690
Related