VBA - apply formula and paste

[omnivl]

I have the following data in A1 that has been pasted from another sheet

Category	Description	Weight	Points	Vendor Score
Criteria	Description of item 1	6%	10	8
Criteria	Description of item 2	6.5%	10	7
Criteria	Description of item 3	10%	10	6
Criteria	Description of item 4	7%	10	5
Totals

<tbody>
</tbody>

In VBA i would like to apply the formula (Vendor Score * Weight) * Points and update the Vendor Score so it looks like so

Category	Description	Weight	Points	Vendor 1 Score
Criteria	Description of item 1	6%	10	4.8%
Criteria	Description of item 2	6.5%	10	4.55%
Criteria	Description of item 3	10%	10	6%
Criteria	Description of item 4	7%	10	3.5%
Totals

<tbody>
</tbody>

The other issue i have is that in Category it could be 4 or 10 or x number of criteria but the last row will always be Totals, likewise with Vendor 1 Score, there could be a number of vendors so Vendor 1 Score, Vendor 2 Score in columns ....

Any help would be awesome...my head hurts

 

[omnivl]

Hi guys
still struggling with this - any help would be welcomed

 

[Marcelo Branco]

Assuming data in columns A:E, headers in row 1

Try in a copy of your workbook

Sub aTest()
    Dim lastRow As Long
    
    lastRow = Cells(Rows.Count, "E").End(xlUp).Row
    With Range("E2:E" & lastRow)
        .Value = Evaluate(Replace("=C2:C@*D2:D@*E2:E@/100", "@", lastRow))
        .NumberFormat = "0.00%"
    End With
End Sub

Hope this helps

M.

 

[omnivl]

Assuming data in columns A:E, headers in row 1

Try in a copy of your workbook

Sub aTest()
    Dim lastRow As Long
    
    lastRow = Cells(Rows.Count, "E").End(xlUp).Row
    With Range("E2:E" & lastRow)
        .Value = Evaluate(Replace("=C2:C@*D2:D@*E2:E@/100", "@", lastRow))
        .NumberFormat = "0.00%"
    End With
End Sub

Hope this helps

M.

Thats great this does column e, but as above "likewise with Vendor 1 Score, there could be a number of vendors so Vendor 1 Score, Vendor 2 Score in columns ...."
is there a way i could incorporate

lastcol = Cells(Columns.Count, "E").End(xlUp).Column

and change the range

 

[Marcelo Branco]

Thats great this does column e, but as above "likewise with Vendor 1 Score, there could be a number of vendors so Vendor 1 Score, Vendor 2 Score in columns ...."
is there a way i could incorporate

lastcol = Cells(Columns.Count, "E").End(xlUp).Column

and change the range

Try to provide a data sample with more columns along with expected results.

M.

 

[omnivl]

Try to provide a data sample with more columns along with expected results.

M.

Category	Description <tbody> </tbody>	Criteria weighting	Points available	Vendor 1	Vendor 2	Vendor 3
TBC	TBC	6.67%	10	10	7	7
TBC	TBC	6.67%	10	10	8	8
TBC	TBC	6.66%	10	10	5	5
TBC	TBC	5.00%	10	10	5	5
TBC	TBC	5.00%	10	10	10	10
TBC	TBC	5.00%	10	10	10	5
TBC	TBC	10.00%	10	10	10	10
TBC	TBC	2.00%	10	10	0	0
TBC	TBC	1.00%	10	10	0	0
TBC	TBC	1.00%	10	10	10	10
TBC	TBC	1.00%	10	10	0	0
TBC	TBC	50.00%	-
Totals	-	100.00%	-	110	65	60

<colgroup><col><col><col span="2"><col span="2"><col></colgroup><tbody>
</tbody>

the result (however at the moment it is not updating vendor 2 and vendor 3)

Category	Description	Criteria weighting	Points available	Vendor 1	Vendor 2	Vendor 3
TBC	TBC	6.67%	10	6.67%	7	7
TBC	TBC	6.67%	10	6.67%	8	8
TBC	TBC	6.66%	10	6.66%	5	5
TBC	TBC	5.00%	10	5.00%	5	5
TBC	TBC	5.00%	10	5.00%	10	10
TBC	TBC	5.00%	10	5.00%	10	5
TBC	TBC	10.00%	10	10.00%	10	10
TBC	TBC	2.00%	10	2.00%	0	0
TBC	TBC	1.00%	10	1.00%	0	0
TBC	TBC	1.00%	10	1.00%	10	10
TBC	TBC	1.00%	10	1.00%	0	0
TBC	TBC	50.00%	-
Totals	-	100.00%	-	0.5	65	60

<colgroup><col style="width:98pt" width="131"> <col style="width:239pt" width="319"> <col style="width:77pt" span="2" width="103"> <col style="width:79pt" span="3" width="105"> </colgroup><tbody>
</tbody>

Code

Option Explicit
Private Sub CommandButton1_Click()
    Dim c
    Dim lastRow As Long
    Worksheets("scoring").Range("A1:ZV10000").Clear
    Worksheets("scoring").Range("A1:ZV10000").ClearFormats
    
    For Each c In Range("A1:IV1").Cells
        If c = "" Then
        Columns(1).Resize(, c.Column - 1).EntireColumn.Copy Destination:=Sheets("scoring").Columns(1)
            Exit For
        End If
    Next
    Worksheets("scoring").Activate
    lastRow = Cells(Rows.Count, "E").End(xlUp).Row
    With Worksheets("scoring").Range("E2:E" & lastRow - 2)
        .Value = Evaluate(Replace("=C2:C@*D2:D@*E2:E@/100", "@", lastRow))
        .NumberFormat = "0.00%"
    End With
    Worksheets("eval").Activate
End Sub

Thanks for the help

 

[Marcelo Branco]

Something like this...

Sub aTest()
    Dim firstCol As Long, lastCol As Long, lastRow As Long
    Dim i As Long
    
    With Sheets("scoring")
        'Define column of the first vendor
        firstCol = 5
        'Get last column
        lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        
        'loop through columns
        For i = firstCol To lastCol
            'Get lastrow with data of column i
            lastRow = .Cells(.Rows.Count, i).End(xlUp).Row - 2
            
            With Range(.Cells(2, i), .Cells(lastRow, i))
                .Value = Evaluate(Replace("=C2:C@*D2:D@*" & .Address & "/100", "@", lastRow))
                .NumberFormat = "0.00%"
            End With
        Next i
    End With
End Sub

M.

 

[Marcelo Branco]

The code above needs a small adjustment. Try...

Sub aTest()
    Dim firstCol As Long, lastCol As Long, lastRow As Long
    Dim i As Long
    
    With Sheets("scoring")
        'Define column of the first vendor
        firstCol = 5
        'Get last column
        lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        
        'loop through columns
        For i = firstCol To lastCol
            'Get lastrow with data of column i
            lastRow = .Cells(.Rows.Count, i).End(xlUp).Row - 2
            
            With Range(.Cells(2, i), .Cells(lastRow, i))
                .Value = [B]Sheets("scoring")[/B].Evaluate(Replace("=C2:C@*D2:D@*" & .Address & "/100", "@", lastRow))
                .NumberFormat = "0.00%"
            End With
        Next i
    End With
End Sub

M.

 

[omnivl]

The code above needs a small adjustment. Try...

Sub aTest()
    Dim firstCol As Long, lastCol As Long, lastRow As Long
    Dim i As Long
    
    With Sheets("scoring")
        'Define column of the first vendor
        firstCol = 5
        'Get last column
        lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        
        'loop through columns
        For i = firstCol To lastCol
            'Get lastrow with data of column i
            lastRow = .Cells(.Rows.Count, i).End(xlUp).Row - 2
            
            With Range(.Cells(2, i), .Cells(lastRow, i))
                .Value = [B]Sheets("scoring")[/B].Evaluate(Replace("=C2:C@*D2:D@*" & .Address & "/100", "@", lastRow))
                .NumberFormat = "0.00%"
            End With
        Next i
    End With
End Sub

M.

You sir, are a legend.....thanks works perfect!