excel vba to multiply columns using header names

[varghesemathew]

Please help me to find a vba code to multiply two column data using its header names (column will vary each time)
Eg: Two columns with header name "Unit Price" and "Quantity". The sum should be multiplication of these two columns.

regards

Varghese Mathew

 

[Joe4]

Welcome to the Board!
We need a bit more information in order to be able to help you.

How many rows of data are we talking about?
Are the headers always in row one?
Where are we gotten to put this value we are calculating?
Do you want VBA to populate the actual formula, or just the value?

 

[varghesemathew]

Hi!

Thank you for the response. Here is the reply.

Rows are not fixed. It depends on the volume of data. Hence Range should be 'used range'
Headers are always in Row 2. Column varies when some columns have data.
Calculation result should appear in column K (K3:K)
I would like to have the VBA to get the result.

regards

Varghese Mathew

 

[Joe4]

Try this:

Sub MyMacro()

    Dim lr As Long, r As Long
    Dim uCol As Long, qCol As Long
    
    Application.ScreenUpdating = False
    
'   Find last used row on sheet
    lr = Range("A1").SpecialCells(xlLastCell).Row
    
    On Error GoTo err_chk
'   Find location of Unit Price
    uCol = Rows("2:2").Find(What:="Unit Price", After:=Range("A2"), LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Column

'   Find location of Quantity
    qCol = Rows("2:2").Find(What:="Quantity", After:=Range("A2"), LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Column
    On Error GoTo 0
    
'   Loop through all rows starting in row 3
    For r = 3 To lr
'       If there are numbers in each column, calculate product and put in column K
        If (Cells(r, uCol) <> 0) And (Cells(r, qCol) <> 0) Then
            Cells(r, "K") = Cells(r, uCol) * Cells(r, qCol)
        End If
    Next r
    
    Application.ScreenUpdating = True
    
    MsgBox "Process complete", vbOKOnly
    
    Exit Sub
    
    
'error handling
err_chk:
    If Err.Number = 91 Then
        MsgBox "Cannot find Unit Price and Quantity headers in row 2", vbOKOnly, "ERROR!"
    Else
        MsgBox Err.Number & ": " & Err.Description
    End If
    
    Application.ScreenUpdating = True
    
End Sub

 

[varghesemathew]

Hi!

Great! It works well.

Thanks a lot!!

regards


Varghese Mathew

 

[Joe4]

You are welcome.
Glad I was able to help!