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
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Sort by date Sort by votes
Is there already a macro that generates this report? It seems like a simple formula solution would do the trick: C2=B2/B$5 and copy down, C6=B6/B$10 and copy down
 
Last edited:
Upvote 0
elmer007 - thanks for the reply. There is a macro that already generates this report, but the problem I'm having is there are different numbers of carriers in each of the "groups" with a total line, so it's impossible to put B$5 or B$10. Some lanes only have 1 carrier and others have 15 carriers, so I don't know if there's an macro that can have the tonnage for each line divided by the tonnage at the "total" row.
 
Upvote 0
Try this, for results starting "C2".
Code: 
[COLOR="Navy"]Sub[/COLOR] MG12Jan39
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, nRng [COLOR="Navy"]As[/COLOR] Range, Tot [COLOR="Navy"]As[/COLOR] Double, R [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Temp [COLOR="Navy"]As[/COLOR] Range, Num [COLOR="Navy"]As[/COLOR] Double
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not Trim(Dn.Value) = "Total" [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]Set[/COLOR] nRng = Dn
        [COLOR="Navy"]Else[/COLOR]
            [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, Dn)
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] nRng.Areas
    Num = 0: Tot = Application.Sum(R.Offset(, 1))
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] R
        Dn.Offset(, 2).Value = Format(Dn.Offset(, 1).Value / Tot, "0.0%")
        Num = Num + Dn.Offset(, 1).Value / Tot
        [COLOR="Navy"]Set[/COLOR] Temp = Dn.Offset(1)
    [COLOR="Navy"]Next[/COLOR] Dn
Temp.Offset(, 2).Value = Format(Num, "0.0%")
[COLOR="Navy"]Next[/COLOR] R
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
elmer007 - thanks for the reply. There is a macro that already generates this report, but the problem I'm having is there are different numbers of carriers in each of the "groups" with a total line, so it's impossible to put B$5 or B$10. Some lanes only have 1 carrier and others have 15 carriers, so I don't know if there's an macro that can have the tonnage for each line divided by the tonnage at the "total" row.
Click to expand...
If you could post the existing macro that would be helpful, then we could see what to modify to add in the 3rd column
 
Last edited:
Upvote 0
elmer007 said:
If you could post the existing macro that would be helpful, then we could see what to modify to add in the 3rd column
Click to expand...

My spreadsheet is much more advanced than the example I gave, thus the macro is very complicated. I don't want to list out the rows, but here are the columns:

Concatenate of O-D & Carrier (A) | Origin-Destination (B) | Carrier (C) | Rail Spend (D) | Rail Tons (E) | Rail $/Ton (F) | Truck Spend (G) | Truck Tons (H) | Truck $/Ton (I) | Total Spend (J) | Total Tons (K) | Total $/Ton (L) | Allocated % of Tons (M) | Actual % of Tons (N) |

Basically, I need the Truck Tons for each carrier to be divided by the Total Tons that are on the origin-destination lane, and have that number listed in the "Actual % of Tons" column M.

It's complicated, but here's the code:

Code: 
 Sub macro1()
Dim lastrow As Long, i 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
'
Tot_Dollar = 0
Tot_Ton = 0
Ton_Rate = 0
Tot_Dollar2 = 0
Tot_Ton2 = 0
Tot_Dollar3 = 0
Tot_Ton3 = 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
            ' hit a blank row, output totals and re-initialize accumulators
            
            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
    
    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
 
Upvote 0
Ok, so I'm not 100% sure of the layout of your spreadsheet, but I've tried to infer from the headers and the code. What if you declare another variable k (as either long or integer), and put something like the following before you reset all the dollar and tonnage variables (about line 53):
Code: 
k = i - 1
Do Until Not (IsNumber(Cells(k, 4))) Or Cells(k, 3) = "TOTAL"
     Cells(k, 14) = Cells(k, 10) / Tot_Dollar3
     k = k - 1
Loop

so that, including your existing code before and after it, that section looks like:
Code: 
...

Cells(i, 10) = Tot_Dollar3
Cells(i, 11) = Tot_Ton3

If Tot_Ton3 > 0 Then
Cells(i, 12) = Tot_Dollar3 / Tot_Ton3
End If

k = i - 1
Do Until Not (IsNumber(Cells(k, 4))) Or Cells(k, 3) = "TOTAL"
Cells(k, 14) = Cells(k, 10) / Tot_Dollar3
k = k - 1
Loop
 
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

...

The added section is intended to work backwards up the data until it either finds the previous "TOTAL" line or the range Cells(k,4) is not a number (the header row). On each row, it sets the value to be the line's dollars (column 10?) divided by the total dollars.

My numbering may be off, but hopefully this makes sense and applies to your sheet.
 
Last edited:
Upvote 0
I can't thank you enough elmer007! I'm getting very close to getting my desired result. I changed a few things with your code and I keep getting an error "Run-time error '6': Overflow".
All I changed in your code was changing "Cells(k, 14) = Cells(k, 10) / Tot_Dollar3" to "Cells(k, 14) = Cells(k, 8) / Tot_Ton2"

I did this because I wanted to divide the tons by the total tons for just trucking, compared to using the total spend. Column 14 is "Actual %", Column 10 is "Total Spend" (Truck & Rail Combined) and Column 8 is "Truck Tons". Would I be correct in changing the code from 10 to 8? Also I changed Tot_Dollar3 to Tot_Ton2.

Also, I changed "IsNumber" to "IsNumeric" because that's the VBA code for Excel's version of "IsNumber".

Thanks again for your help!
 
Upvote 0
Good catch on the IsNumeric- got my wires crossed...

I'm not sure about the overflow error. I don't think that it's the result of your modifications, though. If you put a breakpoint in the code and step through it, what is the value of Tot_Ton2 before the error is thrown?
 
Last edited:
Upvote 0
What if you change the added section of code to be:
Code: 
k = i - 1
Do Until Not (IsNumber(Cells(k, 4))) Or Cells(k, 3) = "TOTAL"
Cells(k, 14) = CLng(Cells(k, 10)) / Tot_Dollar3
k = k - 1
Loop

I have to admit that I don't understand this page https://msdn.microsoft.com/en-us/library/aa264525(v=vs.60).aspx at the moment (does anyone know why 2,000 is larger than Integer after being coerced?), but maybe applying it's fix will work
 
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,517
Messages
6,179,233
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