Speed up VBA - Populate Column Based on Another

[chibibenz]

Hello,

I have a basic VBA code that populates formulas in column D based on the value in column C (it's converting time zones, and needs to account for daylight savings). The problem is the code needs to run for a huge number of cells (~1 million records) and it is currently prohibitively slow. I'm sure there's another way to rewrite the code to run more efficiently. Any ideas?

Here is the current code:

last_row = ActiveSheet.UsedRange.Rows.Count

For i = 2 To last_row

    If Cells(i, 3).Value < "43534.33" Then
         Cells(i, 4).FormulaR1C1 = "=RC[-1]-(6/24)"
   ElseIf Cells(i, 3).Value < "43772.29" Then
         Cells(i, 4).FormulaR1C1 = "=RC[-1]-(5/24)"
      Else
         Cells(i, 4).FormulaR1C1 = "=RC[-1]-(6/24)"
        End If
  Next i

 

[DanteAmor]

Hi and welcome to the forum!

The important thing is to remove the formulas so that the process is faster.
Try this:

Sub test()
  Dim a As Variant, i As Long
  a = Range("C2", Range("C" & Rows.Count).End(xlUp)).Value2
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    If a(i, 1) < 43534.33 Then
      b(i, 1) = a(i, 1) - (6 / 24)
    ElseIf a(i, 1) < 43772.29 Then
      b(i, 1) = a(i, 1) - (5 / 24)
    Else
      b(i, 1) = a(i, 1) - (6 / 24)
    End If
  Next
  Range("D2").Resize(UBound(b), 1).Value = b
End Sub

 

[DanteAmor]

I think this improvement will help with the process performance.

Sub test1()
  Dim a As Variant, i As Long
  a = Range("C2", Range("C" & Rows.Count).End(xlUp)).Value2
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    If a(i, 1) > 43534.33 And a(i, 1) < 43772.29 Then
      b(i, 1) = a(i, 1) - (5 / 24)
    Else
      b(i, 1) = a(i, 1) - (6 / 24)
    End If
  Next
  Range("D2").Resize(UBound(b), 1).Value = b
End Sub

 

[chibibenz]

I think this improvement will help with the process performance.

Sub test1()
  Dim a As Variant, i As Long
  a = Range("C2", Range("C" & Rows.Count).End(xlUp)).Value2
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    If a(i, 1) > 43534.33 And a(i, 1) < 43772.29 Then
      b(i, 1) = a(i, 1) - (5 / 24)
    Else
      b(i, 1) = a(i, 1) - (6 / 24)
    End If
  Next
  Range("D2").Resize(UBound(b), 1).Value = b
End Sub

Thank you - that worked! I just ran it on the full dataset and it only took 2 minutes (I have a lot of other clunky code I wrote that's probably slowing it down too). I really appreciate your help!

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.

 

[Peter_SSs]

I am only talking about very small amounts here but this should shave a tiny bit more off the run time.
I have split the If .. And ... Then line into 2
While it is in a single line the code needs to evaluate both parts. By splitting into 2, if the first check fails then there is no need to evaluate the second one.

The other change is to just do those divisions once rather than for every row.

Sub ConvertToDST_v2()
  Dim a As Variant, i As Long
  Dim Diff1 As Double, Diff2 As Double
  Diff1 = 5 / 24
  Diff2 = 6 / 24
  a = Range("C2", Range("C" & Rows.Count).End(xlUp)).Value2
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    If a(i, 1) > 43534.33 Then
      If a(i, 1) < 43772.29 Then
        b(i, 1) = a(i, 1) - Diff1
      Else
        b(i, 1) = a(i, 1) - Diff2
      End If
    Else
      b(i, 1) = a(i, 1) - Diff2
    End If
  Next
  Range("D2").Resize(UBound(b), 1).Value = b
End Sub

These changes reduced the run time for me by about 6% - not a lot but it may be of interest to you. Also, I don't have the "other clunky code I wrote that's probably slowing it down" which may mean that my changes suggested here make even less difference percentage-wise.

 

[DanteAmor]

What if you try Peter's suggestions in the 2 codes presented above in post #2 and post #3

Sub test()
  Dim a As Variant, i As Long
  Dim Diff1 As Double, Diff2 As Double
  Diff1 = 5 / 24
  Diff2 = 6 / 24

  a = Range("C2", Range("C" & Rows.Count).End(xlUp)).Value2
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    If a(i, 1) < 43534.33 Then
      b(i, 1) = a(i, 1) -  Diff2
    ElseIf a(i, 1) < 43772.29 Then
      b(i, 1) = a(i, 1) - Diff1
    Else
      b(i, 1) = a(i, 1) -  Diff2
    End If
  Next
  Range("D2").Resize(UBound(b), 1).Value = b
End Sub

__________________________________________________________________________

Sub test1()
  Dim a As Variant, i As Long
  Dim Diff1 As Double, Diff2 As Double
  Diff1 = 5 / 24
  Diff2 = 6 / 24

  a = Range("C2", Range("C" & Rows.Count).End(xlUp)).Value2
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    If a(i, 1) > 43534.33 And a(i, 1) < 43772.29 Then
      b(i, 1) = a(i, 1) - Diff1 
    Else
      b(i, 1) = a(i, 1) - Diff2 
    End If
  Next
  Range("D2").Resize(UBound(b), 1).Value = b
End Sub

Maybe this helps in your processing. You'll tell us how you're doing.

 

[chibibenz]

Thank you both for your help. I ran the macro (along with my other clunky code) three times with each of the different options to compare.

This was the code that was the fastest:

Sub test1()
  Dim a As Variant, i As Long
  Dim Diff1 As Double, Diff2 As Double
  Diff1 = 5 / 24
  Diff2 = 6 / 24

  a = Range("C2", Range("C" & Rows.Count).End(xlUp)).Value2
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    If a(i, 1) > 43534.33 And a(i, 1) < 43772.29 Then
      b(i, 1) = a(i, 1) - Diff1 
    Else
      b(i, 1) = a(i, 1) - Diff2 
    End If
  Next
  Range("D2").Resize(UBound(b), 1).Value = b
End Sub

Can you help me understand in layman's terms how this code is working? I would like to try to optimize the rest of my code as it's clearly got all kinds of mess in it slowing it down, and I would like to attempt it myself if possible so I can get better at this.

I understand (I think) that you pulled the formulas out of the code as much as possible by pre-defining the range for it to review. So it looks like the code

  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)

is basically creating a dynamic range that just gets redefined as each successive cell in column C, is that right? Or...I guess that chunk of code is defining "b"? Which part of the code tells it that "b" is the cell to the right of cell "a"?

Thanks for any help or insights!

 

[Peter_SSs]

Can you help me understand in layman's terms how this code is working?

I'll try.

One of the things that slows code considerably is constant interactions between the code and the worksheet itself as those interactions are (relatively) slow. If you have say 1 million rows then your original code interacts with the worksheet 2 million times - for each cell it goes to the sheet to get that cell's value and once it works out which formula is required it goes back to the sheet to enter that formula. A small amount of time is also then consumed as that formula calculates & then displays its result.

The main difference between your code and mine (& Dante's is similar in this regard) is that there are only 2 interactions between the code and the worksheet.
The first interaction is that all the values in col C are read into an array at once. That array (a) is stored in the computer's memory. Another array (b) the same size as a is also set up in memory to hold the results.
The results are calculated** in memory and written into the b array.
The second (& last) interaction between the code and worksheet is that the results array (b) is written (all at once) back to the sheet in column D

** The calculation of each result is basically the same as your original formula except that
- it all happens in the computer's memory and
- as mentioned before, I have calculated (once) and stored the divisions 5/24 and 6/24. These divisions take a tiny amount of time but there are a million of them if you do one every row. By storing those results my code then just has to access the correct figure and do a subtraction rather than do a division and a subtraction every row.

Hope that makes some sense & good luck with your 'cleaning up'!

 

[DanteAmor]

This was the code that was the fastest:

Can you help me understand

I can see that you took the structure of my code shown in post #3 for being the fastest.

The main difference between your code and my code is the reading of the data and the writing of the results.
I explain with the following lines of your code:

If Cells(i, 3).Value < "43534.33" Then
Cells(i, 4).FormulaR1C1 = "=RC[-1]-(6/24)"

Your code compares the value against a cell. If the condition is met then you write the result in the cell. This means that you perform 2 processes with the sheet. And this you do a million times.

While my code:

If a(i, 1) > 43534.33 And a(i, 1) < 43772.29 Then
b(i, 1) = a(i, 1) - Diff1

Compare the value against a variable stored in memory; and the result is stored in memory. If you can see at any time the sheet is touched.
Until the end of the process, only one write on the sheet will be made:
Range("D2").Resize(UBound(b), 1).Value = b

The process is faster in memory than reading and writing on the sheet.

I hope I could help you a little to understand the code.
Thanks for the feedback.