VBA: Multiply cells by weights

[shaon0]

I have a large table in the form:

Months	August	September	October	November	December
August	112	A	B	C	D
September		118	E	F	G
October			231	H	I
November				142	J
December					253

<tbody>
</tbody>

Which only has diagonal values corresponding to the months that do intersect along the rows and columns.

I also have weights like the following: 80%, 110%, 95%.

I would like to multiply these weights by the diagonal entries depending on how far the column and row months are away from each other.

For example for the August row, we would have:

• A = 112*80% (since it is one month away, we would multipy it by the first weight),
• B = 112*80%*110% (October is two months away from August so we would multiply by the first and second weights)
• C = 112*80%*110%*95% (Multiply by the three weights)
• D = 112*80%*110%*95%*95% (since we have run out of weights to use, we will use the last weight we had).

The same would be extended to the September row etc.

Unfortunately, I am not sure how to do this with VB so any help would be very appreciated.

 

[wideboydixon]

If the weights are hard-coded then you could do this with formulas. However, it's a trivial exercise with VBA:

Public Sub MultiplyByWeights()

Dim lastRow As Long
Dim lastCol As Long
Dim thisRow As Long
Dim thisCol As Long
Dim weightsArray
Dim newValue As Double
Dim i As Long

' Set up the weightings
weightsArray = Array(0.8, 1.1, 0.95)

' Find the last row as column
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
lastCol = Cells(1, Columns.Count).End(xlToLeft).Column

' Go down each row
For thisRow = 2 To lastRow
    ' Go across each columns
    For thisCol = thisRow + 1 To lastCol
        ' Take the value from the diagonal
        newValue = Cells(thisRow, thisRow).Value
        
        ' Multiply it by the weights
        For i = 0 To thisCol - thisRow - 1
            newValue = newValue * weightsArray(IIf(i <= UBound(weightsArray), i, UBound(weightsArray)))
        Next i
        
        ' Put in the new value
        Cells(thisRow, thisCol).Value = newValue
    Next thisCol
Next thisRow

End Sub

WBD

 

[shaon0]

If the weights are hard-coded then you could do this with formulas. However, it's a trivial exercise with VBA:

Public Sub MultiplyByWeights()

Dim lastRow As Long
Dim lastCol As Long
Dim thisRow As Long
Dim thisCol As Long
Dim weightsArray
Dim newValue As Double
Dim i As Long

' Set up the weightings
weightsArray = Array(0.8, 1.1, 0.95)

' Find the last row as column
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
lastCol = Cells(1, Columns.Count).End(xlToLeft).Column

' Go down each row
For thisRow = 2 To lastRow
    ' Go across each columns
    For thisCol = thisRow + 1 To lastCol
        ' Take the value from the diagonal
        newValue = Cells(thisRow, thisRow).Value
        
        ' Multiply it by the weights
        For i = 0 To thisCol - thisRow - 1
            newValue = newValue * weightsArray(IIf(i <= UBound(weightsArray), i, UBound(weightsArray)))
        Next i
        
        ' Put in the new value
        Cells(thisRow, thisCol).Value = newValue
    Next thisCol
Next thisRow

End Sub

WBD

Wow, amazing. This is exactly what I was looking for. Thanks for your help.