Question

I have this code that works. it goes down a range and deletes the empty rows, seperates the first character into a different column if its not a number or negative sign.
This code WORKS. but it is too SLOW for the amount of data i need it to deal with.
Thank you anyone for your suggestion on how to optimize this code and make it faster.

I have already turned off automatic calculations. screen updating. and visibility of application.

Dim rng As Range
Dim i As Long
Dim Tracking As Long

Dim textval As String
Dim limitz As String
Dim remaining As String

Range("B1").End(xlDown).Offset(0, 5).Select

Set rng = Range("G2", ActiveCell).Select

i = 1
Range("G2").Select

For Tracking = 1 To rng.Rows.Count

    textval = rng.Cells(i).Value
    limitz = Left(textval, 1)

    If limitz = "" Then
      rng.Cells(i).EntireRow.Delete
     ElseIf limitz <> "0" And limitz <> "1" And limitz <> "2" And limitz <> "3" And limitz <> "4" And limitz <> "5" And limitz <> "6" And limitz <> "7" And limitz <> "8" And limitz <> "9" And limitz <> "-" Then
      remaining = Right(textval, Len(textval) - 1)
      rng.Cells(i) = remaining
      rng.Cells(i).Offset(0, 1).Value = limitz
      i = i + 1
     Else
      i = i + 1
    End If

Next

Answer 1

There is not so much code that seems to be obviously inefficient.

Here is some tips about what I can tell:

• Don’t select cells unless you are really forced too (as it is not within your loop, that is not the worst thing)
• Try to parse range instead of using a Long
• Change your test with a vba statement like IsNumeric
• Use With to avoid calling an object multiple times

Here is a try (i may have changed some behavior because i couldn’t understand if you wanted to parse cells or rows):

Sub test()
  Dim rng As Range, row As Range
  Dim i As Long

  Dim textval As String
  Dim limitz As String
  Dim remaining As String

  Set rng = Range("G2", Range("B1").End(xlDown).Offset(0, 5))
  i = 1

  For Each row In rng.Rows
      With row
        textval = .Cells(i).Value
        limitz = Left(textval, 1)

        If limitz = "" Then
            .Cells(i).EntireRow.Delete
        ElseIf limitz <> "-" And Not IsNumeric(limitz) Then
          remaining = Right(textval, Len(textval) - 1)
          With .Cells(i)
            .Value = remaining
            .Offset(0, 1).Value = limitz
          End With
          i = i + 1
         Else
          i = i + 1
        End If
      End With
  Next
End Sub