Search code examples
excelvbamultiplication

vba Multiply Range with Range


I'd like to multiply the cells of column P with the cells in column M and replace the content of column P with the respective product. Afterwards I want to do the exact same thing with columns Q and N.

I've been trying to look this issue up and the closest solution was: VBA multiply two named ranges

Unfortunately, after running through the first column and calculating it, Excel gives me a runtime error 13 - type mismatch.

My code:

Sub rechnen_mod()

Dim aud_y As Range
Dim soc_r As Range
Dim mp_y As Range
Dim mp_r As Range

Set aud_y = Sheets("MRP score template").[P11:P1000]
Set soc_r = Sheets("MRP score template").[Q11:Q1000]
Set mp_y = Sheets("MRP score template").[M11:M1000]
Set mp_r = Sheets("MRP score template").[N11:N1000]

For i = 1 To Range("P").End(xlDown).Row
    aud_y(i, 1) = aud_y(i, 1) * mp_y(i, 1)
Next i

For j = 1 To Range("Q").End(xlDown).Row
    soc_r(j, 1) = soc_r(j, 1) * mp_r(j, 1)
Next j

End Sub

Any help would be very appreciated.

EDIT: After reading <stackoverflow.com/a/22056347/11231520> I changed the code to:

Public Sub array1()

Dim x As Long
Dim arr
Dim arr_e
Dim arrf
Dim arrf_e
Dim results
Dim r As Range

arr = Sheets("MRP score template").[P11:P473]
arrf = Sheets("MRP score template").[M11:M473]

ReDim results(1 To UBound(arr) * UBound(arrf))

For Each arr_e In arr
    For Each arrf_e In arrf
        x = x + 1
        results(x) = arr_e * arrf_e
    Next arrf_e
Next arr_e

Set r = Sheets("calc").Range("A1:A" & UBound(results))

r = Application.Transpose(results)

End Sub

Excel gives me a runtime error 13 - type mismatch with the explanation that arrf_e = error 2402. After a quick research this should mean that the array contains #NA - but it doesn't.

After clicking on debugging, the marked line is

results(x) = arr_e * arrf_e


Solution

  • Try to use below code instead. I also added comments to explain each step :)

    Option Explicit
    
    Public Sub rechnen_mod()
        Dim mp_y() As Variant
        Dim mp_r() As Variant
        Dim aud_y() As Variant
        Dim soc_r() As Variant
        Dim arrResult_P() As Variant
        Dim arrResult_Q() As Variant
        Dim iLastRow As Integer
        Dim iSizeArrays As Integer
        Dim iIndexSearch As Integer
        
        With ThisWorkbook.Worksheets("MRP score template")
            ' Find last row of table, replace it with fixed value if you prefer
            iLastRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
            
            ' Store data in arrays
            mp_y = .Range("M11", "M" & iLastRow).Value
            mp_r = .Range("N11", "N" & iLastRow).Value
            aud_y = .Range("P11", "P" & iLastRow).Value
            soc_r = .Range("Q11", "Q" & iLastRow).Value
            
            ' Calculate size of arrays
            iSizeArrays = UBound(mp_y) - LBound(mp_y) + 1
            
            ' ReDim result arrays according to iSizeArrays
            ReDim arrResult_P(1 To iSizeArrays)
            ReDim arrResult_Q(1 To iSizeArrays)
            
            ' Calculate result values
            For iIndexSearch = 1 To iSizeArrays
                arrResult_P(iIndexSearch) = mp_y(iIndexSearch, 1) * aud_y(iIndexSearch, 1)
                arrResult_Q(iIndexSearch) = mp_r(iIndexSearch, 1) * soc_r(iIndexSearch, 1)
            Next iIndexSearch
            
            ' Write results in the worksheet
            .Range("P11", "P" & iLastRow) = Application.WorksheetFunction.Transpose(arrResult_P)
            .Range("Q11", "Q" & iLastRow) = Application.WorksheetFunction.Transpose(arrResult_Q)
        End With
    End Sub
    

    I tested it with random values on 250 rows and it worked fine.