简体   繁体   中英

How to set a formula from VBA to assign cell value?

I am setting a cell value in Sheet1 with a formula that involves cells from Sheet1 and Sheet2. Is there a way to set such formula from VBA?

Here is what I have:

I fill some information from B11 to M11 all over to row number 29, like filling a form per rows. Some times it will be only one row with information and it could also be all of the tables with data.

In column G, I have a dropdown and according to the value from this dropdown, the respective H cell is filled.

I manage to set the formula for that, but due to security, I want to set it from VBA.

=IFERROR(VLOOKUP(G11;Data!B2:D13;3;FALSE);0)

WorksheetFunction.Vlookup() works quite nicely, if you use correctly the Ranges and the parameters:

Public Function SomeFormula() As Variant

    On Error GoTo SomeFormula_Error

    Dim result As Variant
    result = WorksheetFunction.VLookup(Range("G11"), Worksheets("Data").Range("B2:D13"), 3, False)
    SomeFormula = result

    On Error GoTo 0
    Exit Function

SomeFormula_Error:

    SomeFormula = 0

End Function

You could just keep your formula in G column and protect that range so user can't edit it.

Alternatively, using the Worksheet_Change event handler:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cl As Range
Dim val as Variant
' In case the change is NOT in column G, then Exit.
If Intersect(Target, Columns("G")) Is Nothing Then Exit Sub
For Each cl in Intersect(Target, Columns("G"))
    val = Application.Vlookup(cl.Value, ThisWorkbook.Worksheets("Data").Range("B2:D13"), 3, False)
    If IsError(val) Then
        cl.Offset(0, 1).Value = 0
    Else
        cl.offset(0, 1).Value = val
    End If
Next
End Sub

If you need to do the same sort of thing against multiple columns, it's a little trickier because you can only have one Worksheet_Change handler in a given sheet. So you'll need to modify it like below. This could use to be streamlined a bit to reduce some redundancy, but that's an exercise for another Question :)

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cl As Range
Dim val as Variant
' Handles column G
If Not Intersect(Target, Columns("G")) Is Nothing Then 

    For Each cl in Intersect(Target, Columns("G"))
        val = Application.Vlookup(cl.Value, ThisWorkbook.Worksheets("Data").Range("B2:D13"), 3, False)
        If IsError(val) Then
            cl.Offset(0, 1).Value = 0
        Else
            cl.offset(0, 1).Value = val
        End If
    Next
End If
If Not Intersect(Target, Columns("J") Is Nothing Then
    For Each cl in Intersect(Target, Columns("J"))
        val = { your formula used for populating column J }  '## UPDATE THIS WITH YOUR PROPER FORMULA/FUNCTION
        If IsError(val) Then
            cl.Offset(0, 3).Value = 0
        Else
            cl.offset(0, 3).Value = val
        End If
    Next
End Sub

You can use the macro recorder : go to the developer tab in the ribbon then record macro then click on your cell with the formula then click stop recording in ribbon then open up VBA and excel will have already generated the macro for you.

When I do this I get the following:

    Sub Macro1()
        Range("A1").Select
    'I have entered my formula in cell A1
        ActiveCell.FormulaR1C1 = _
            "=IFERROR(VLOOKUP(R[10]C[6],Data!R[1]C[1]:R[12]C[3],3,FALSE),0)"
    End Sub

this is the macro I came up with. It will cycle through the range you specified and apply the vlookup you are asking for. This will only run when you actually run the macro.

Sub Macro1()
Dim startRow as Integer
Dim endRow as Integer
Dim wsData as Worksheet

'just edit the Sheet2 name to the actual sheet name
Set wsData as ActiveWorkbook.Worksheets("Sheet2")
'this is the starting row of your B11 and the end row of your M29
startRow = 11
endRow = 29


'For loop to look at each row in your range on sheet1 that you want to populate
For startRow To endRow
    'This assign the value returned by the vlookup to the cell H of whatever row it is now checking
    wsData.Cells(startRow, 8).Value = Iferror(vlookup(startRow, 7;wsData.Range(Cells(2, 2), Cells(13, 4));3;False);0)
Next startRow

End sub

Tell me if you encounter any issues or have any questions.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM