VBA multiply all cells in range with corresponding row value

[milanso]

Hi, I'm trying the following,
I have the below data which needs to be copied below this data and each cell if larger than 0 in columns b-e multiplied with the corresponding value in column a.

a	b	c	d	e
1.02	237	358	0	715
0.35	1	0	120	0
0.71	51	0	0	0
1.21	683	481	0	612
0.67	704	501	0	1002
1.07	372	325	300	650
1.07	350	325	55	650

<colgroup><col style="width:48pt" width="64" span="5"> </colgroup><tbody>
</tbody>

 

[Roxxien]

Hello milanso,

You can try this formula

=IF(B2>0,B2*$A2,"smaller than 0")

You can change the text "smaller than 0" by whatever you want to happen if the value is smaller than 0.

 

[milanso]

Sorry if I wasn't clear enough, but I need this done in VBA.

 

[Roxxien]

o well! my bad

Sub test()Dim r As Range


For Each r In Range("A1:E7")
    If r > 0 Then
        r.Offset(7, 0) = r * r.Offset(0, r.column() - 1)
    End If
Next


End Sub

 

[Strooprover]

Hi,

I'm pretty new with VBA and for practise reasons I gave your question a try as well. I made a code that you can still use if you expand your Table.

Sub Test()
Range("A2").Select
     Range(Selection, Selection.End(xlDown)).Select
    Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
For MyRow = 2 To Range("A" & Rows.Count).End(xlUp).Row
For mycol = 2 To Cells(1, Columns.Count).End(xlToLeft).Column
i = Range("A" & Rows.Count).End(xlUp).Row
If Cells(MyRow, mycol) > 0 Then
Cells(MyRow + i, mycol).Value = Cells(MyRow, mycol) * Cells(MyRow, 1)
Else: Cells(MyRow + i, mycol).Value = 0
End If
Next mycol
Next MyRow

End Sub

I've run it and it seems to work. Tips are Always welcome.

Gr.

 

[Roxxien]

hum, i think that your code could have some modification. I will modify some part in red and put some comment.

Sub Test()
[COLOR=#ff0000]Range("A2").Select 'why select this?[/COLOR]
     [COLOR=#ff0000]Range(Selection, Selection.End(xlDown)).Select 'the way to select on a line than using selection after is ... slowing your code and moving your mouse[/COLOR]
    [COLOR=#ff0000]Range(Selection, Selection.End(xlDown))[/COLOR].Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False 'However, I don't understand why you are replacing "." by "," in french we use comma for decimal, but in Excel in english, it's a dot
        
For MyRow = 2 To Range("A" & Rows.Count).End(xlUp).Row
For mycol = 2 To Cells(1, Columns.Count).End(xlToLeft).Column
i = Range("A" & Rows.Count).End(xlUp).Row
If Cells(MyRow, mycol) > 0 Then
Cells(MyRow + i, mycol) = Cells(MyRow, mycol) * Cells(MyRow, 1) 'I deleted .value because this attribute is the one used by default in VBA, no use to have it
Else 
Cells(MyRow + i, mycol) = 0 'You should but your else part on another line
End If
Next mycol
Next MyRow

End Sub

 

[Strooprover]

Hi, thanks for responding!

I've got the dutch version from excel. Maybe that's why I have to change the "." to ",". But I've changed it now to:

   Range("A1", Selection.End(xlDown)).Select
    Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

Thanks for your constructive help!
If you have more tips for me they're very welcome!