How to calculate percentages with VBA

A

adamjon92

New Member
Joined
Dec 8, 2015
Messages
22
Good morning,

I had a question that I'm hoping isn't too complicated. Basically, I have tonnage in a spreadsheet for multiple carriers, and I need to find an easy way to divide the tonnage for one carrier by the tonnage for all of the carriers combined. For example:

I need to turn this...

Carrier | Tonnage
ABC | 10
DEF | 15
GHI | 25
Total | 50
JKL | 30
MNO | 15
PQR | 25
STU | 30
Total | 100

Into this...

Carrier | Tonnage | Percentage
ABC | 10 | 20%
DEF | 15 | 30%
GHI | 25 | 50%
Total | 50 | 100%
JKL | 30 | 30%
MNO | 15 | 15%
PQR | 25 | 25%
STU | 30 | 30%
Total | 100 | 100%


I already have the carrier and tonnage in my report, but I'm having trouble writing a macro to figure out the percentage.

Any help is appreciated!

Adam
 
Sort by date Sort by votes
Ok, so in the same vein, it may be that Cells(k, 10) and Tot_Dollar3 are both 0 when this line runs, which could return an overflow error instead of a divide-by-zero error
 
Upvote 0

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).
elmer007 said:
Ok, so in the same vein, it may be that Cells(k, 10) and Tot_Dollar3 are both 0 when this line runs, which could return an overflow error instead of a divide-by-zero error
Click to expand...

Would it be a problem if I changed Cells(k, 10) and Tot_Dollar3 to Cells(k, 8) and Tot_Ton2? Same problem?
 
Upvote 0
I'm running into a bigger problem now. The k value is correct (row 4 because i = 5 in this situation), but the Tot_Ton2 keeps showing up as 0. I believe this is because the sums don't occur until after this step. Basically, it is dividing the tons by 0 because there isn't a sum for the total tons. I believe I will have to make a 2nd macro because whenever I run my first macro (the macro I pasted on the first page), I get all of the summed values, so I believe I will have to add another variable in the 2nd macro that will act as a variable for the tons for each lane.

I also kept getting the error that I was dividing by 0, which would be consistent with not having total tons. Let's say the tons from NY -> LA on carrier ABC was 100, the tons from NY -> LA on carrier DEF was 50, and the tons from NY -> LA on carrier GHI was 50, carrier ABC would have an actual % of 50%, carrier DEF would have an actual % of 25%, and carrier GHI would have an actual % of 25%. However, the total of 200 is not being calculated, in this example, so the macro is erroring out before it can sum the 200. However, when I added your macro after the "Add the last total line" step, it summed everything except for the first grouping of lanes and carriers, and it added the actual percentages for the last grouping of lanes. So maybe the problem is that the first grouping of lanes and carriers isn't working for some reason? Any ideas? By the way, I added my new code below:

Code: 
Sub macro1()
Dim lastrow As Long, i As Long, k As Long
Dim Tot_Dollar As Long, Tot_Ton As Long, Ton_Rate As Long, Tot_Dollar2 As Long, Tot_Ton2 As Long, Tot_Dollar3 As Long, Tot_Ton3 As Long, Act_Ton2 As Long
'
Tot_Dollar = 0
Tot_Ton = 0
Ton_Rate = 0
Tot_Dollar2 = 0
Tot_Ton2 = 0
Tot_Dollar3 = 0
Tot_Ton3 = 0
Act_Ton2 = 0
'
    With ActiveSheet
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
    For i = lastrow To 5 Step -1
        If Not Cells(i, 2) = Cells(i - 1, 2) Then
            Rows(i).Insert shift:=xlShiftDown
        End If
    Next i
    
    With ActiveSheet
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
    For i = 5 To lastrow
        ' Start at 3 existing sub sets row 2 to blank
            If Cells(i, 2) = "" Then
            Cells(i, 3) = "TOTAL"
            Cells(i, 4) = Tot_Dollar
            Cells(i, 5) = Tot_Ton
            
            If Tot_Ton > 0 Then
            Cells(i, 6) = Tot_Dollar / Tot_Ton
            End If
            Cells(i, 7) = Tot_Dollar2
            Cells(i, 8) = Tot_Ton2
            If Tot_Ton2 > 0 Then
            Cells(i, 9) = Tot_Dollar2 / Tot_Ton2
            End If
            Cells(i, 10) = Tot_Dollar3
            Cells(i, 11) = Tot_Ton3
            If Tot_Ton3 > 0 Then
            Cells(i, 12) = Tot_Dollar3 / Tot_Ton3
            End If
            Tot_Dollar = 0
            Tot_Ton = 0
            Tot_Dollar2 = 0
            Tot_Ton2 = 0
            Tot_Dollar3 = 0
            Tot_Ton3 = 0
        Else
            Tot_Dollar = Tot_Dollar + Cells(i, 4)
            Tot_Ton = Tot_Ton + Cells(i, 5)
            Tot_Dollar2 = Tot_Dollar2 + Cells(i, 7)
            Tot_Ton2 = Tot_Ton2 + Cells(i, 8)
            Tot_Dollar3 = Tot_Dollar3 + Cells(i, 10)
            Tot_Ton3 = Tot_Ton3 + Cells(i, 11)
            End If
    Next i
    ' Add the last total line
    Cells(lastrow + 1, 3) = "TOTAL"
    Cells(lastrow + 1, 4) = Tot_Dollar
    Cells(lastrow + 1, 5) = Tot_Ton
    Cells(lastrow + 1, 7) = Tot_Dollar2
    Cells(lastrow + 1, 8) = Tot_Ton2
    Cells(lastrow + 1, 10) = Tot_Dollar3
    Cells(lastrow + 1, 11) = Tot_Ton3
            
[B] k = i - 1
    Do Until Not (IsNumeric(Cells(k, 7))) Or Cells(k, 3) = "TOTAL"
    Cells(k, 14) = CLng(Cells(k, 8)) / Tot_Ton2
    k = k - 1
    Loop[/B]

    If Tot_Ton > 0 Then
    Cells(lastrow + 1, 6) = Tot_Dollar / Tot_Ton
    Else
    Tot_Dollar = 0
    Tot_Ton = 0
    End If
    
    If Tot_Ton2 > 0 Then
    Cells(lastrow + 1, 9) = Tot_Dollar2 / Tot_Ton2
    Else
    Tot_Dollar2 = 0
    Tot_Ton2 = 0
    End If
    If Tot_Ton3 > 0 Then
    Cells(lastrow + 1, 12) = Tot_Dollar3 / Tot_Ton3
    Tot_Dollar3 = 0
    Tot_Ton3 = 0
    End If
End Sub

Thanks again for your assistance! I really appreciate it.
 
Upvote 0
Is this the layout of your spreadsheet (with some made-up sample data), starting in A1 ("Concat Column" cell)?

[table="width: 1200, class: grid"]
[tr]
[td]Concat Column[/td]
[td]Origin-Destination[/td]
[td]Carrier[/td]
[td]Rail Spend[/td]
[td]Rail Tons[/td]
[td]Rail $/Ton[/td]
[td]Truck Spend[/td]
[td]Truck Tons[/td]
[td]Truck $/Ton[/td]
[td]Total Spend[/td]
[td]Total Tons[/td]
[td]Total $/Ton[/td]
[td]Allocated % of Tons[/td]
[td]Actual % of Tons[/td]
[/tr]
[tr]
[td]NY-LAABC[/td]
[td]NY-LA[/td]
[td]ABC[/td]
[td]20000[/td]
[td]45[/td]
[td]444.44[/td]
[td]10000[/td]
[td]10[/td]
[td]1000[/td]
[td]30000[/td]
[td]55[/td]
[td]545.45[/td]
[td](to fill with macro also?)[/td]
[td](to fill with macro)[/td]
[/tr]
[tr]
[td]NY-LAABC[/td]
[td]NY-LA[/td]
[td]ABC[/td]
[td]25000[/td]
[td]50[/td]
[td]500[/td]
[td]15000[/td]
[td]12[/td]
[td]1250[/td]
[td]40000[/td]
[td]62[/td]
[td]645.16[/td]
[td](to fill with macro also?)[/td]
[td](to fill with macro)[/td]
[/tr]
[/table]
 
Upvote 0
elmer007 said:
Is this the layout of your spreadsheet (with some made-up sample data), starting in A1 ("Concat Column" cell)?

[table="width: 1200, class: grid"]
[tr]
[td]Concat Column[/td]
[td]Origin-Destination[/td]
[td]Carrier[/td]
[td]Rail Spend[/td]
[td]Rail Tons[/td]
[td]Rail $/Ton[/td]
[td]Truck Spend[/td]
[td]Truck Tons[/td]
[td]Truck $/Ton[/td]
[td]Total Spend[/td]
[td]Total Tons[/td]
[td]Total $/Ton[/td]
[td]Allocated % of Tons[/td]
[td]Actual % of Tons[/td]
[/tr]
[tr]
[td]NY-LAABC[/td]
[td]NY-LA[/td]
[td]ABC[/td]
[td]20000[/td]
[td]45[/td]
[td]444.44[/td]
[td]10000[/td]
[td]10[/td]
[td]1000[/td]
[td]30000[/td]
[td]55[/td]
[td]545.45[/td]
[td](to fill with macro also?)[/td]
[td](to fill with macro)[/td]
[/tr]
[tr]
[td]NY-LAABC[/td]
[td]NY-LA[/td]
[td]ABC[/td]
[td]25000[/td]
[td]50[/td]
[td]500[/td]
[td]15000[/td]
[td]12[/td]
[td]1250[/td]
[td]40000[/td]
[td]62[/td]
[td]645.16[/td]
[td](to fill with macro also?)[/td]
[td](to fill with macro)[/td]
[/tr]
[/table]
Click to expand...

Exactly. I couldn't figure out a way to fill out a table in here, but you have it correct. For the allocated % column, there is another spreadsheet that it is pulling from, so I just have a simple vLookup that is working fine.
 
Upvote 0
Ok (yeah I think tables are too hard to make on here unless you use whatever the tools are that some of the other people have...). I think that maybe the total-ing process of our existing macro isn't working quite right. How about using the following:
Code: 
Sub Add_Subtotals_And_Percentages()

Dim i As Long, k As Long
Dim myRange As Range
Set myRange = Range("A2") 'this is the first cell of data
i = myRange.Row 'will use this to know the range for the SUM functions

'This next Loop inserts rows for TOTALS and constructs the formulas to go in the cells
Do Until IsEmpty(myRange.Offset(-1, 0))
    If myRange.Value <> myRange.Offset(-1, 0).Value And myRange.Offset(-1, 2) <> "Carrier" Then
        myRange.EntireRow.Insert
        myRange.Offset(-1, 2).Value = "TOTALS"
        myRange.Offset(-1, 3).Formula = "=SUM(D" & i & ":D" & myRange.Row - 2 & ")"
        myRange.Offset(-1, 4).Formula = "=SUM(E" & i & ":E" & myRange.Row - 2 & ")"
        myRange.Offset(-1, 5).Formula = "=IFERROR(D" & myRange.Row - 1 & "/E" & myRange.Row - 1 & ", 0)"
        myRange.Offset(-1, 6).Formula = "=SUM(G" & i & ":G" & myRange.Row - 2 & ")"
        myRange.Offset(-1, 7).Formula = "=SUM(H" & i & ":H" & myRange.Row - 2 & ")"
        myRange.Offset(-1, 8).Formula = "=IFERROR(G" & myRange.Row - 1 & "/H" & myRange.Row - 1 & ", 0)"
        myRange.Offset(-1, 9).Formula = "=SUM(J" & i & ":J" & myRange.Row - 2 & ")"
        myRange.Offset(-1, 10).Formula = "=SUM(K" & i & ":K" & myRange.Row - 2 & ")"
        myRange.Offset(-1, 11).Formula = "=IFERROR(J" & myRange.Row - 1 & "/K" & myRange.Row - 1 & ", 0)"
        With myRange.Offset(-1, 2).Resize(1, 12)
            .Font.Bold = True
        End With
        With myRange.Offset(-1, 2).Resize(1, 10)
            .NumberFormat = "#,##0.00"
        End With
        
        'This Loop adds formulas for the percentages for column N
        Do Until i = myRange.Row
            myRange.Offset(-(myRange.Row - i), 13).Formula = "=IFERROR(K" & i & "/K" & myRange.Offset(-1, 10).Row & ", 0)"
            With myRange.Offset(-(myRange.Row - i), 13)
                .Style = "Percent"
            End With
            i = i + 1
        Loop
        
    End If
    Set myRange = myRange.Offset(1, 0)
Loop

End Sub

It works on my test data, but maybe it's not the result you're looking for. Just let me know
 
Last edited:
Upvote 0
No worries! It worked perfectly, so I can't say thank you enough! This isn't too important, but it's worth a shot to ask..so currently, TOTALS gets added below the carriers for the lane, but is there any way to copy the lane down next to TOTALS so whenever people try to sort by lane, the totals come up too? And is there any way to bold the entire row? Like I said, you've already done more than enough for me and I appreciate everything you've helped me with, but it was worth asking. Thanks!
 
Upvote 0
I'm assuming that the lane is the Origin-Destination column:
Code: 
Sub Add_Subtotals_And_Percentages()

Dim i As Long, myRange As Range
Set myRange = Range("A2") 'this is the first cell of data
i = myRange.Row

Do Until IsEmpty(myRange.Offset(-1, 0))
    If myRange.Value <> myRange.Offset(-1, 0).Value And myRange.Offset(-1, 2) <> "Carrier" Then
        myRange.EntireRow.Insert
        'myRange.Offset(-1, 0).Formula = "=B" & myRange.Row - 1 & "&C" & myRange.Row - 1  'uncomment this row to include the formula for column A
        myRange.Offset(-1, 1).Value = myRange.Offset(-2, 1).Value
        myRange.Offset(-1, 2).Value = "TOTALS"
        myRange.Offset(-1, 3).Formula = "=SUM(D" & i & ":D" & myRange.Row - 2 & ")"
        myRange.Offset(-1, 4).Formula = "=SUM(E" & i & ":E" & myRange.Row - 2 & ")"
        myRange.Offset(-1, 5).Formula = "=IFERROR(D" & myRange.Row - 1 & "/E" & myRange.Row - 1 & ", 0)"
        myRange.Offset(-1, 6).Formula = "=SUM(G" & i & ":G" & myRange.Row - 2 & ")"
        myRange.Offset(-1, 7).Formula = "=SUM(H" & i & ":H" & myRange.Row - 2 & ")"
        myRange.Offset(-1, 8).Formula = "=IFERROR(G" & myRange.Row - 1 & "/H" & myRange.Row - 1 & ", 0)"
        myRange.Offset(-1, 9).Formula = "=SUM(J" & i & ":J" & myRange.Row - 2 & ")"
        myRange.Offset(-1, 10).Formula = "=SUM(K" & i & ":K" & myRange.Row - 2 & ")"
        myRange.Offset(-1, 11).Formula = "=IFERROR(J" & myRange.Row - 1 & "/K" & myRange.Row - 1 & ", 0)"
        With myRange.Offset(-1, 2).EntireRow
            .Font.Bold = True
        End With
        With myRange.Offset(-1, 2).Resize(1, 10)
            .NumberFormat = "#,##0.00"
        End With
        
        'This Loop adds formulas for the percentages for column N
        Do Until i = myRange.Row
            myRange.Offset(-(myRange.Row - i), 13).Formula = "=IFERROR(K" & i & "/K" & myRange.Offset(-1, 10).Row & ", 0)"
            With myRange.Offset(-(myRange.Row - i), 13)
                .Style = "Percent"
            End With
            i = i + 1
        Loop
        
    End If
    Set myRange = myRange.Offset(1, 0)
Loop

End Sub

You could also include the carrier's name in their TOTALS row if you want; change the line of code that has "TOTALS" in it to be:
Code: 
myRange.Offset(-1, 2).Value = myRange.Offset(-2, 2).Value & " TOTALS"
instead.

If people are going to sort this table as in re-ordering it alphabetically or something, then the SUM functions will probably break. If they only filter as in selecting just one lane to view, then they should be ok. If they will re-order the rows, then we can re-work it to just put the result of the formula in the TOTALS row instead of the actual formula itself.
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question Question
Formula to calculate how much to add or subtract to keep totals even
Replies
7
Views
188
MrHoyt
M
M
  • Question Question
Excel macro for returning values based on adjacent cells and further calculations
2
Replies
10
Views
603
Joe4
Joe4
JTL9161
  • Question Question
COUNTIF line varies
Replies
2
Views
289
JTL9161
JTL9161
J
  • Solved
Creating a formula while isolating one part of the information in a row
Replies
1
Views
240
steve the fish
steve the fish
P
  • Question Question
vba question
Replies
6
Views
224
Pinkyhello
P

Forum statistics

Threads
1,224,516
Messages
6,179,231
Members
452,898
Latest member
Capolavoro009

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