Setting data range and speeding up VBA code

[artz]

Hi,

I have some simple VBA code which does not work the way I want. It's probably something simple. First, in the code

LastRow = Cells(Rows.Count, "B").End(xlUp).Row

I would like to start the row count at row B3 not row B1; tried several options but all returned errors.

Sub Test2()
Dim LastRow As Long, i As Long
LastRow = Cells(Rows.Count, "B").End(xlUp).Row
For i = 1 To LastRow
Range("M" & i).Value = "dog"
    If Range("M" & i).Value = "dog" Then Range("N" & i).Value = "cat"
Next i
End Sub

Although this code returns an answer, it is very slow. It takes 5 minutes to process only about 20,000 rows. If anyone in the Forum could help move the range starting point to cell B3 and speed up execution time to a couple of seconds that would be great. And BTW, I'm not locked into this code, whatever works best will be used.

Any help would be very much appreciated. Am running this on Excel 2007 and Excel 2016.

Thanks,

-Art

 

[Fluff]

Why are you setting the value of col M in each row to "dog" & then checking to see if it equals "dog"?

 

[artz]

Hi Kenneth,

I am setting up an architecture that will have several if statements in the final embodiment so wanted to have that hook in to see how it would run.

Make sense?

-Art

 

[Kenneth Hobson]

By adding the dog value and then the cat value one at a time, you double the time it takes.

Why not test the solutions posted rather than look elsewhere? You would do well to better define what you want and answer questions that are meant to help us help you better.

Array and filter methods will be super fast. I suspect that Rick's formula method would be ok too. I will run some time tests. The true comparison is when the solutions return the same result.

Here is my autofilter version. Of course it matters little if we don't know what you want. The autofilter method only returns the dog values to column N. My array method could do that but it also returns the other values. Note that the autofilter method is case insensitive. Dog<>dog. My array method is case sensitive but could be made case insensitive.

Sub Test2()
  Dim r As Range, f As Range
  Set r = Range("M3:M" & Cells(Rows.Count, "B").End(xlUp).Row)
  r.AutoFilter 1, "=dog"
  r.Offset(, 1) = "cat"
  r.AutoFilter
End Sub

After posting this I see that you will have multiple If's. This can matter in the solution. For my array method, it is no big deal. For the other methods, it may be significant. Depending on the If's, AdvancedFilter might be worth consideration.

 

[artz]

All,

Thanks so much for the response! I should have posted this earlier. When I said that I multiple if statements, the code below shows what I am trying to do. That code is static; only works for several fixed cells. As I tried to make it dynamic, it went from switching between two values based on cell values to cats and dogs from an online code example. I am sorry if I took everybody down a rabbit hole but here's my starting code. It just needs to be made dynamic.

Sub UpDown()

Dim a As Double, b As Double, c As Double, d As Double, result As Double

a = Range("B2").Value
b = Range("C2").Value
c = Range("B3").Value
d = Range("C3").Value

If a > b And c > d Then
    result = 1

ElseIf a < b And c < d Then
    result = 0

End If

Range("L2").Value = result

End Sub

Does anybody see how to do this efficiently?

Thanks,

-Art

 

[Kenneth Hobson]

Here are my time test results in seconds.

Sub avg
Test 0.63
Test2 0.33
MM 0.37
DogToCat 0.91

 

[artz]

Hi Kenneth,

Were you filling down 20,000 + rows?

-Art

 

[Kenneth Hobson]

Why not just use a 2 If() formula in L2 and fill/copy down?

If it becomes static, code could set the values to static.

 

[Kenneth Hobson]

No, tests were for 200,000 rows with 3 runs each and averaged.

If you run the time test sub, run it from a blank sheet. Run MakeColMDogs() to fill data prior to AvgRunTimes().

Sub Test()
  Dim i As Long, a
  a = Range("M3:M" & Cells(Rows.Count, "B").End(xlUp).Row)
  For i = 1 To UBound(a)
    If a(i, 1) = "dog" Then a(i, 1) = "cat"
  Next i
  Range("N3").Resize(UBound(a)) = a
End Sub

Sub Test2()
  Dim r As Range, f As Range
  Set r = Range("M3:M" & Cells(Rows.Count, "B").End(xlUp).Row)
  r.AutoFilter 1, "=dog"
  r.Offset(, 1) = "cat"
  r.AutoFilter
End Sub

Sub MM()
  Dim lastrow As Long, rng As Range
  lastrow = Cells(Rows.Count, "B").End(xlUp).Row
  With ActiveSheet 'change sheet name to suit
      Set rng = .Range("M3:M" & lastrow)
      rng.AutoFilter Field:=1, Criteria1:="dog"
      rng.Offset(1, 1).SpecialCells(12).Value = "cat"
      .AutoFilterMode = False
  End With
End Sub

Sub DogToCat()
  With Range("M3:M" & Cells(Rows.Count, "B").End(xlUp).Row)
    .Offset(, 1) = Evaluate(Replace(Replace("IF(@=""dog"",""cat"",if(#="""","""",#))", "@", .Address), "#", .Offset(, 1).Address))
  End With
End Sub

Sub AvgRunTimes()
    Dim d As Double, dd As Double
    Dim s As String
    Dim j As Integer, k As Integer
    Dim jj As Integer, kk As Integer
      
    jj = 4   'Number of single Sub runs.
    kk = 3 'Number of replicate runs
    
    For k = 1 To kk 'Replicate runs
        For j = 1 To jj 'Single runs
            ClearColN 'Clear a previous run
            'Number of choices should be jj, if not, change value of jj.
            s = Choose(j, "Test", "Test2", "MM", "DogToCat")
            d = Timer
            Application.Run s
            dd = Timer
            Debug.Print s, dd - d & " seconds."
        Next j
    Next k
    'ActiveSheet.UsedRange.Columns.AutoFit
End Sub

Sub MakeColMDogs()
  ActiveSheet.UsedRange.Clear
  [B200002] = 1 '200k rows
  Range("M3:M" & Cells(Rows.Count, "B").End(xlUp).Row) = "dog"
  [M3] = "Dog" 'Case sensitive check cell
End Sub

Sub ClearColN()
  On Error Resume Next
  Intersect(Columns("N:N"), ActiveSheet.UsedRange).Clear
End Sub

 

[Kenneth Hobson]

When comparing those, you can have more than just 2 cases. As such, this will have some blank cells when neither case is met.

Run the 2nd sub first with blank sheet active. Then run the 1st sub.

Sub Test3()
  Dim a, b, i As Long, ri As Integer
  
  a = Range("B2", Cells(Rows.Count, "B").End(xlUp)).Resize(, 2)
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a) - 1
    Select Case True
      Case a(i, 1) > a(i, 2) And a(i + 1, 1) > a(i + 1, 2)
        b(i, 1) = 1
      Case a(i, 1) < a(i, 2) And a(i + 1, 1) < a(i + 1, 2)
        b(i, 1) = 0
      Case Else
    End Select
  Next i
  
  [L2].Resize(UBound(a)) = b
End Sub

Sub BCrandoms()
  With [B2:C200001]
    .Formula = "=RandBetween(1,100)"
    .Value = .Value
  End With
End Sub

 

[artz]

Hi Kenneth,

Thanks for your continued help. I'll try your suggestion of starting with a blank sheet and see how that does with your code. The discrepancy between your sub execution time and mine is crazy. I will try this in a little bit.

Thanks,

-Art