VBA - apply formula and paste

O

omnivl

Board Regular
Joined
Aug 25, 2014
Messages
53
I have the following data in A1 that has been pasted from another sheet

[TABLE="width: 500"]
<tbody>[TR]
[TD]Category
[/TD]
[TD]Description
[/TD]
[TD]Weight
[/TD]
[TD]Points
[/TD]
[TD]Vendor Score
[/TD]
[/TR]
[TR]
[TD]Criteria
[/TD]
[TD]Description of item 1
[/TD]
[TD]6%
[/TD]
[TD]10
[/TD]
[TD]8
[/TD]
[/TR]
[TR]
[TD]Criteria
[/TD]
[TD]Description of item 2
[/TD]
[TD]6.5%
[/TD]
[TD]10
[/TD]
[TD]7
[/TD]
[/TR]
[TR]
[TD]Criteria
[/TD]
[TD]Description of item 3
[/TD]
[TD]10%
[/TD]
[TD]10
[/TD]
[TD]6
[/TD]
[/TR]
[TR]
[TD]Criteria
[/TD]
[TD]Description of item 4
[/TD]
[TD]7%
[/TD]
[TD]10
[/TD]
[TD]5
[/TD]
[/TR]
[TR]
[TD]Totals
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

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

[TABLE="width: 500"]
<tbody>[TR]
[TD]Category
[/TD]
[TD]Description
[/TD]
[TD]Weight
[/TD]
[TD]Points
[/TD]
[TD]Vendor 1 Score
[/TD]
[/TR]
[TR]
[TD]Criteria
[/TD]
[TD]Description of item 1
[/TD]
[TD]6%
[/TD]
[TD]10
[/TD]
[TD]4.8%
[/TD]
[/TR]
[TR]
[TD]Criteria
[/TD]
[TD]Description of item 2
[/TD]
[TD]6.5%
[/TD]
[TD]10
[/TD]
[TD]4.55%
[/TD]
[/TR]
[TR]
[TD]Criteria
[/TD]
[TD]Description of item 3
[/TD]
[TD]10%
[/TD]
[TD]10
[/TD]
[TD]6%
[/TD]
[/TR]
[TR]
[TD]Criteria
[/TD]
[TD]Description of item 4
[/TD]
[TD]7%
[/TD]
[TD]10
[/TD]
[TD]3.5%
[/TD]
[/TR]
[TR]
[TD]Totals
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

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
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
Sort by date Sort by votes
Assuming data in columns A:E, headers in row 1

Try in a copy of your workbook

Code: 
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.
 
Upvote 0
Marcelo Branco said:
Assuming data in columns A:E, headers in row 1

Try in a copy of your workbook

Code: 
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.
Click to expand...

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
 
Upvote 0
omnivl said:
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
Click to expand...

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

M.
 
Upvote 0
Marcelo Branco said:
Try to provide a data sample with more columns along with expected results.

M.
Click to expand...

[TABLE="width: 971"]
<colgroup><col><col><col span="2"><col span="2"><col></colgroup><tbody>[TR]
[TD]Category
[/TD]
[TD="align: left"]
clip_image002.png
Description

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


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


[TABLE="width: 971"]
<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>[TR]
[TD="class: xl19, width: 131"]Category[/TD]
[TD="class: xl20, width: 319"]Description[/TD]
[TD="class: xl21, width: 103"]Criteria weighting[/TD]
[TD="class: xl21, width: 103"]Points available[/TD]
[TD="class: xl22, width: 105"]Vendor 1[/TD]
[TD="class: xl22, width: 105"]Vendor 2[/TD]
[TD="class: xl22, width: 105"]Vendor 3[/TD]
[/TR]
[TR]
[TD="class: xl25, width: 131"]TBC[/TD]
[TD="class: xl25, width: 319"]TBC[/TD]
[TD="class: xl25, width: 103"]6.67%[/TD]
[TD="class: xl25, width: 103"]10[/TD]
[TD="class: xl27"]6.67%[/TD]
[TD="class: xl27"]7[/TD]
[TD="class: xl27"]7[/TD]
[/TR]
[TR]
[TD="class: xl25, width: 131"]TBC[/TD]
[TD="class: xl25, width: 319"]TBC[/TD]
[TD="class: xl25, width: 103"]6.67%[/TD]
[TD="class: xl25, width: 103"]10[/TD]
[TD="class: xl27"]6.67%[/TD]
[TD="class: xl27"]8[/TD]
[TD="class: xl27"]8[/TD]
[/TR]
[TR]
[TD="class: xl25, width: 131"]TBC[/TD]
[TD="class: xl25, width: 319"]TBC[/TD]
[TD="class: xl25, width: 103"]6.66%[/TD]
[TD="class: xl25, width: 103"]10[/TD]
[TD="class: xl27"]6.66%[/TD]
[TD="class: xl27"]5[/TD]
[TD="class: xl27"]5[/TD]
[/TR]
[TR]
[TD="class: xl25, width: 131"]TBC[/TD]
[TD="class: xl25, width: 319"]TBC[/TD]
[TD="class: xl25, width: 103"]5.00%[/TD]
[TD="class: xl25, width: 103"]10[/TD]
[TD="class: xl27"]5.00%[/TD]
[TD="class: xl27"]5[/TD]
[TD="class: xl27"]5[/TD]
[/TR]
[TR]
[TD="class: xl25, width: 131"]TBC[/TD]
[TD="class: xl25, width: 319"]TBC[/TD]
[TD="class: xl25, width: 103"]5.00%[/TD]
[TD="class: xl25, width: 103"]10[/TD]
[TD="class: xl27"]5.00%[/TD]
[TD="class: xl27"]10[/TD]
[TD="class: xl27"]10[/TD]
[/TR]
[TR]
[TD="class: xl25, width: 131"]TBC[/TD]
[TD="class: xl25, width: 319"]TBC[/TD]
[TD="class: xl25, width: 103"]5.00%[/TD]
[TD="class: xl25, width: 103"]10[/TD]
[TD="class: xl27"]5.00%[/TD]
[TD="class: xl27"]10[/TD]
[TD="class: xl27"]5[/TD]
[/TR]
[TR]
[TD="class: xl25, width: 131"]TBC[/TD]
[TD="class: xl25, width: 319"]TBC[/TD]
[TD="class: xl25, width: 103"]10.00%[/TD]
[TD="class: xl25, width: 103"]10[/TD]
[TD="class: xl27"]10.00%[/TD]
[TD="class: xl27"]10[/TD]
[TD="class: xl27"]10[/TD]
[/TR]
[TR]
[TD="class: xl25, width: 131"]TBC[/TD]
[TD="class: xl25, width: 319"]TBC[/TD]
[TD="class: xl25, width: 103"]2.00%[/TD]
[TD="class: xl25, width: 103"]10[/TD]
[TD="class: xl27"]2.00%[/TD]
[TD="class: xl27"]0[/TD]
[TD="class: xl27"]0[/TD]
[/TR]
[TR]
[TD="class: xl25, width: 131"]TBC[/TD]
[TD="class: xl25, width: 319"]TBC[/TD]
[TD="class: xl25, width: 103"]1.00%[/TD]
[TD="class: xl25, width: 103"]10[/TD]
[TD="class: xl27"]1.00%[/TD]
[TD="class: xl27"]0[/TD]
[TD="class: xl27"]0[/TD]
[/TR]
[TR]
[TD="class: xl25, width: 131"]TBC[/TD]
[TD="class: xl25, width: 319"]TBC[/TD]
[TD="class: xl25, width: 103"]1.00%[/TD]
[TD="class: xl25, width: 103"]10[/TD]
[TD="class: xl27"]1.00%[/TD]
[TD="class: xl27"]10[/TD]
[TD="class: xl27"]10[/TD]
[/TR]
[TR]
[TD="class: xl25, width: 131"]TBC[/TD]
[TD="class: xl25, width: 319"]TBC[/TD]
[TD="class: xl25, width: 103"]1.00%[/TD]
[TD="class: xl25, width: 103"]10[/TD]
[TD="class: xl27"]1.00%[/TD]
[TD="class: xl27"]0[/TD]
[TD="class: xl27"]0[/TD]
[/TR]
[TR]
[TD="class: xl25, width: 131"]TBC[/TD]
[TD="class: xl25, width: 319"]TBC[/TD]
[TD="class: xl28, width: 103"]50.00%[/TD]
[TD="class: xl29, width: 103"]-[/TD]
[TD="class: xl27"][/TD]
[TD="class: xl27"][/TD]
[TD="class: xl27"][/TD]
[/TR]
[TR]
[TD="class: xl30"]Totals[/TD]
[TD="class: xl31"]-[/TD]
[TD="class: xl31"]100.00%[/TD]
[TD="class: xl31"]-[/TD]
[TD="class: xl31"]0.5[/TD]
[TD="class: xl31"]65[/TD]
[TD="class: xl31"]60[/TD]
[/TR]
</tbody>[/TABLE]

Code

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
 
Upvote 0
Something like this...

Code: 
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.
 
Upvote 0
The code above needs a small adjustment. Try...

Code: 
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.
 
Upvote 0
Marcelo Branco said:
The code above needs a small adjustment. Try...

Code: 
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.
Click to expand...

You sir, are a legend.....thanks works perfect!
 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Question Question
Formula to help calculate % score based on different criteria
2
Replies
10
Views
2K
BigBeachBananas
B
K
  • Solved
Dynamic Sum Range Addresses...(?)
Replies
2
Views
481
Kenny_D
K
V
  • Question Question
Copy and Paste Multiple sheet data in one sheet Formula
Replies
7
Views
335
vishu
V
N
  • Solved
Duplicates question and scoring system
Replies
6
Views
529
MountainFog
M
N
  • Solved
VBA to delete range between 2 used ranges.
Replies
9
Views
319
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,223,905
Messages
6,175,297
Members
452,633
Latest member
DougMo

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top