VBA Code to fill out column with formula's

[mrsushi]

Good evening,

I have Column A with over 30,000 cells of data.

Column D+E+F+G have formulas run via a VBA script (This is as per below). The problem with applying the below via a script, is it takes forever to complete.

Is there an alternative VBA code to which can be used?

Many thanks




lngLastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("D5:D" & lngLastRow).FormulaR1C1 = "=IF(COUNTIF(R5C1:R50000C1,RC1)>1,""Duplicate"","""")"

lngLastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("E5:E" & lngLastRow).FormulaR1C1 = "=VLOOKUP(CONCATENATE(RC[-4],"" "", RC[-3]),'LT03 Full Data'!C[-4]:C[-2], 2, FALSE)"

lngLastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("F5:F" & lngLastRow).FormulaR1C1 = "=VLOOKUP(CONCATENATE(RC[-5],RC[-4]),'LT03 Full Data'!C[-5]:C[-3], 2, FALSE)"

lngLastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("G5:G" & lngLastRow).FormulaR1C1 = "=IF(ISTEXT(RC[-2]),RC[-2],IF(ISTEXT(RC[-1]),RC[-1]))"

 

[mrsushi]

Column D - IF(COUNTIF($A$5:$A$50000,$A9402)>1,"Duplicate","")

Column E - VLOOKUP(CONCATENATE(A9402," ", B9402),'LT03 Full Data'!A:C, 2, FALSE)
Column F - VLOOKUP(CONCATENATE(A9402,B9402),'LT03 Full Data'!A:C, 2, FALSE)
Column G - IF(ISTEXT(E9402),E9402,IF(ISTEXT(F9402),F9402))

 

[rlv01]

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    lngLastRow = Range("A" & Rows.Count).End(xlUp).Row
    Range("D5:D" & lngLastRow).FormulaR1C1 = "=IF(COUNTIF(R5C1:R50000C1,RC1)>1,""Duplicate"","""")"
    Range("E5:E" & lngLastRow).FormulaR1C1 = "=VLOOKUP(CONCATENATE(RC[-4],"" "", RC[-3]),'LT03 Full Data'!C[-4]:C[-2], 2, FALSE)"
    Range("F5:F" & lngLastRow).FormulaR1C1 = "=VLOOKUP(CONCATENATE(RC[-5],RC[-4]),'LT03 Full Data'!C[-5]:C[-3], 2, FALSE)"
    Range("G5:G" & lngLastRow).FormulaR1C1 = "=IF(ISTEXT(RC[-2]),RC[-2],IF(ISTEXT(RC[-1]),RC[-1]))"

    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True

 

[mrsushi]

Thanks for the above. However, your macro is just as slow as my code. Is there an alternative to entering the formula for each column? By applying the formula, this causes the long processing time.

Would it work via looping using for I?

 

[Fluff]

Do you need to keep the formula in the cells, or is hard values ok?

 

[rlv01]

You might try some performance testing to see which formulas are slowing you down.

    Dim ST As Single
    lngLastRow = Range("A" & Rows.Count).End(xlUp).Row

    ST = Timer
    Range("D5:D" & lngLastRow).FormulaR1C1 = "=IF(COUNTIF(R5C1:R50000C1,RC1)>1,""Duplicate"","""")"
    Debug.Print "Elaped time for Formula 1 = " & Timer - ST
  
    ST = Timer
    Range("E5:E" & lngLastRow).FormulaR1C1 = "=VLOOKUP(CONCATENATE(RC[-4],"" "", RC[-3]),'LT03 Full Data'!C[-4]:C[-2], 2, FALSE)"
    Debug.Print "Elaped time for Formula 2 = " & Timer - ST
   
    ST = Timer
    Range("F5:F" & lngLastRow).FormulaR1C1 = "=VLOOKUP(CONCATENATE(RC[-5],RC[-4]),'LT03 Full Data'!C[-5]:C[-3], 2, FALSE)"
    Debug.Print "Elaped time for Formula 3 = " & Timer - ST
   
    ST = Timer
    Range("G5:G" & lngLastRow).FormulaR1C1 = "=IF(ISTEXT(RC[-2]),RC[-2],IF(ISTEXT(RC[-1]),RC[-1]))"
    Debug.Print "Elaped time for Formula 4 = " & Timer - ST

 

[mrsushi]

Do you need to keep the formula in the cells, or is hard values ok?

Hi fluff.
The formulas don’t need to be in the cells so hard values would be fine.

 

[jasonb75]

You might try some performance testing to see which formulas are slowing you down.

That will be the 2 most inefficient formulas, VLOOKUP combined with entire columns and exact match. The COUNTIF formula is nowhere near as bad but can still be improved.
The effort needed to process the final formula will be minimal.

The countif formula could be made more efficient by changing it to exclude any empty rows at the end of the range,

Range("D5:D" & lngLastRow).FormulaR1C1 = "=IF(COUNTIF(R5C1:R" & lngLastRow & "C1,RC1)>1,""Duplicate"","""")"

Similar could be applied to the vlookup formulas by getting the last row from the Full Data sheet.

 

[Fluff]

Ok, try this for the countif

Sub mrsushi()
   Dim Ary As Variant, Nary As Variant
   Dim i As Long
   
   Ary = Range("A2", Range("A" & Rows.Count).End(xlUp).Row).Value
   ReDim Nary(1 To UBound(Ary), 1 To 1)
   With CreateObject("scripting.dictionary")
      For i = 1 To UBound(Ary)
         If Not .exists(Ary(i, 1)) Then
            .Add Ary(i, 1), i
         Else
            Nary(i, 1) = "Duplicate"
            Nary(.Item(Ary(i, 1)), 1) = "Duplicate"
         End If
      Next i
   End With
   Range("D2").Resize(UBound(Nary)).Value = Nary
End Sub

 

[mrsushi]

Ok, try this for the countif

Sub mrsushi()
   Dim Ary As Variant, Nary As Variant
   Dim i As Long
  
   Ary = Range("A2", Range("A" & Rows.Count).End(xlUp).Row).Value
   ReDim Nary(1 To UBound(Ary), 1 To 1)
   With CreateObject("scripting.dictionary")
      For i = 1 To UBound(Ary)
         If Not .exists(Ary(i, 1)) Then
            .Add Ary(i, 1), i
         Else
            Nary(i, 1) = "Duplicate"
            Nary(.Item(Ary(i, 1)), 1) = "Duplicate"
         End If
      Next i
   End With
   Range("D2").Resize(UBound(Nary)).Value = Nary
End Sub

Many thanks for the code which will apply to column D. To make the other columns return a value too, would a similar script need to be applied to column E + F + G?