CODEWITHSUNDEEP
excelvba
khyati dedhia
khyati dedhia

Reputation: 81

want to convert Excel formula into VBA code

I wanted to convert below formula to VBA code.

 =C1&"`"&K1&"`"&L1&"`"&J1
 =VLOOKUP(M1,Data!$A:$J,9,)
 =SUMPRODUCT(SUMIF(B1:B,B1,G1:G))

Currently i have enter this formula in 1st row and than copying this formula till the last row used which is taking lot time to apply formula because it has more than million row.

 LR1 = Sheets("CRIMS").UsedRange.Rows.Count
    Sheets("CRIMS").Range("M1:P1").AutoFill Destination:=Sheets("CRIMS").Range("M1:P" & LR1)

is there any way to convert this formula into VBA code?

Upvotes: 0

Views: 205

Answers (2)

horst
horst

Reputation: 713

Quotation Marks need to be doubled in VBA

Try this:

For i = 1 To LR1
Range("M" & i).Formula = "=C" & i & "&""`""&K" & i & "&""`""&L" & i & "&""`""&J" & i
Range("N" & i).Formula = "=VLOOKUP(M" & i & ",Data!$A:$J,9,)"
Next i

(replace column letters with actual target column)

As mentioned in the comments Looping in this case is highly inefficient. Use this Code to insert the formulas all at once. It still takes some time for 1 Milion rows though.

Range("M1:M" & LR1).Formula = "=C:C & ""`"" & K:K & ""`"" & L:L & ""`"" & J:J"
Range("N1:N" & LR1).Formula = "=VLOOKUP(M:M,Data!$A:$J,9,)"

Upvotes: 1

Teamothy
Teamothy

Reputation: 2016

For first formula the easiest way would be:

Range("M" & i).FormulaR1C1 = "=RC[-10]&""`""&K&""`""&L&""`""&J"

But for vlookup I prefer dictionaries/collections! It is much much faster.

If You have source data in Data sheet and You want to put that to CRIMS sheet to column M:

Sub vlookup()

    Dim names As Range, values As Range
    Dim lookupNames As Range, lookupValues As Range
    Dim vlookupCol As Object
    Dim lastRow As Long
    Dim lastRow2 As Long
    Dim objekt as Object

    With Sheets("Data")
        lastRow = Sheets("Data").Cells(Rows.Count, 1).End(xlUp).row
        Set names = Sheets("Data").Range("A1:A" & lastRow)
        Set values = Sheets("Data").Range("I1:A" & lastRow)
    End With

        Set objekt = BuildLookupCollection(names, values)

    With Sheets("CRIMS")
        lastRow2 = 1000000
        Set lookupNames = .Range("M1:M" & lastRow)
        Set lookupValues = .Range("N1:N" & lastRow)
    End With

    VLookupValues lookupNames, lookupValues, objekt

    Set objekt = Nothing
End Sub

Function BuildLookupCollection(categories As Range, values As Range)
    Dim vlookupCol As Object, i As Long
    Set vlookupCol = CreateObject("Scripting.Dictionary")

    On Error Resume Next
    For i = 1 To categories.Rows.Count
        Call vlookupCol.Add(CStr(categories(i)), values(i))
    Next i
    On Error GoTo 0

    Set BuildLookupCollection = vlookupCol
End Function

Sub VLookupValues(lookupCategory As Range, lookupValues As Range, vlookupCol As Object)
    Dim i As Long, resArr() As Variant
    ReDim resArr(lookupCategory.Rows.Count, 1)
    For i = 1 To lookupCategory.Rows.Count
        resArr(i - 1, 0) = vlookupCol.Item(CStr(lookupCategory(i)))
    Next i
    lookupValues = resArr
End Sub

Upvotes: 1

Related Questions