Modify VBA code to prepare "SUM' with existing a/cs

Panoos64

Well-known Member
Joined
Mar 1, 2014
Messages
882
Hi all, kindly require to modify the below code so that to still prepare the "SUM" if one or more below accounts are missing.
e.g. if the row in col. "A" with account description "FIXED EXPENSES" & "SUNDRY EXPENSES are missing, the code should run and prepare the "SUM" with the rest of them.

Thanks in advance


Dim Nams As Variant, n As Variant, c As long, oSum(1 To 5) As Double
Dim Rng As Range, Dn As Range, Dic As Object
Set Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
Nams = Array("TOTAL OPERATING EXP.", "COST OF SALES", "DIRECT EXPENSES", "FIXED EXPENSES", "ADMINISTRATION EXPENSES", "SUNDRY ACCOUNTS", "SUNDRY INCOME", "SUNDRY EXPENSES", "MISCELLENEOUS")
Set Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
For Each n In Nams: Dic(n) = Empty: Next
For Each Dn In Rng
If Dic.Exists(Dn.Value) Then
oSum(1) = oSum(1) + Dn.Offset(, 1).Value
oSum(2) = oSum(2) + Dn.Offset(, 3).Value
oSum(3) = oSum(3) + Dn.Offset(, 5).Value
oSum(4) = oSum(4) + Dn.Offset(, 7).Value
oSum(5) = oSum(5) + Dn.Offset(, 9).Value
c = c + 1
End If
If c = Dic.Count Then
With Dn.Offset(1)
.Resize(2).EntireRow.Insert
.Offset(-1).Value = "TOTAL EXPENSES"
.Offset(-1, 1).Value = oSum(1)
.Offset(-1, 3).Value = oSum(2)
.Offset(-1, 5).Value = oSum(3)
.Offset(-1, 7).Value = oSum(4)
.Offset(-1, 9).Value = oSum(5)
End With
Exit Sub
End If
Next Dn

End Sub
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
Try changing:-
This line:

Code:
If c = Dic.Count Then

To this line:-
Code:
If c = Rng.Count Then
 
Upvote 0
Hi Mick, is still not working. It appears a msg as follow:

Run-time error '13':
Type mismatch

Thank you for your support
 
Upvote 0
Hi Mick, the "TOTAL EXPENSES" is the result of TOTAL OPERATING EXP., DIRECT EXPENSES, FIXED EXPENSES and ADMINISTRATION EXPENSES. there is no COST OF SALES or SUNDRY EXPENSES e.t.c. but the code should run too with existing a/cs

Thanks you once again for your support. Hv a great day


ORIGINAL DATA


ABCDEFGHIJK
T.M. L.Y.M. T.Y. L.Y. VARIANCE
40TOTAL OPERATING EXP.
75,100 78,265 800,125 755,458 44,667
41
42G.O.P
35,205 38,474 250,148 260,365 (10,217)
43
44RATES & LICENSES 1,000 5,150 7,200 (2,050)
45ELECTRICITY75 5,147 6,555 (1,408)
46INSURANCES 250 2,200 3,500 (1,300)
47COMMISSIONS45 105 450 355 95
48
DIRECT EXPENSES
120 1,355 12,947 17,610 (4,663)
49
50MANAGEMENT FEES
150 258 6,555 5,459 1,096
51AUDIT FEES 147 5,147 4,258 889
52PROFESSIONAL FEES268 254 3,725 4,178 (453)
53SUNDRY ADMIN EXPENSES 1,785 1,955 (170)
54
FIXED EXPENSES
418 659 17,212 15,850 1,362
55
56N.P.B.F.E
34,667 36,460 219,989 226,905 (6,916)
57
58BANK CHARGES75 90 365 405 (40)
59INTEREST CHARGES158 160 748 810 (62)
60ADMINISTRATION EXPENSES
233 250 1,113 1,215 (102)
61
62
63N. P & L
34,434 36,210 218,876 225,690 (6,814)

<colgroup><col style="mso-width-source:userset;mso-width-alt:768;width:16pt" width="22"> <col style="mso-width-source:userset;mso-width-alt:6769;width:143pt" width="190"> <col style="mso-width-source:userset;mso-width-alt:2190;width:46pt" width="62"> <col style="mso-width-source:userset;mso-width-alt:1251;width:26pt" width="35"> <col style="mso-width-source:userset;mso-width-alt:2019;width:43pt" width="57"> <col style="mso-width-source:userset;mso-width-alt:1166;width:25pt" width="33"> <col style="mso-width-source:userset;mso-width-alt:2076;width:44pt" width="58"> <col style="mso-width-source:userset;mso-width-alt:967;width:20pt" width="27"> <col style="mso-width-source:userset;mso-width-alt:2616;width:55pt" width="74"> <col style="mso-width-source:userset;mso-width-alt:881;width:19pt" width="25"> <col style="mso-width-source:userset;mso-width-alt:1991;width:42pt" width="56"> <col style="mso-width-source:userset;mso-width-alt:1336;width:28pt" width="38"> </colgroup><tbody>
</tbody>


EXPECTED RESULT

ABCDEFGHIJK
T.M. L.Y.M. T.Y. L.Y. VARIANCE
40
TOTAL OPERATING COST
75,100 78,265 800,125 755,458 44,667
41
42G.O.P
35,205 38,474 250,148 260,365 (10,217)
43
44RATES & LICENSES 1,000 5,150 7,200 (2,050)
45ELECTRICITY75 5,147 6,555 (1,408)
46INSURANCES 250 2,200 3,500 (1,300)
47COMMISSIONS45 105 450 355 95
48DIRECT EXPENSES
120 1,355 12,947 17,610 (4,663)
49
50MANAGEMENT FEES150 258 6,555 5,459 1,096
51AUDIT FEES 147 5,147 4,258 889
52PROFESSIONAL FEES268 254 3,725 4,178 (453)
53SUNDRY ADMIN EXPENSES 1,785 1,955 (170)
54FIXED EXPENSES
418 659 17,212 15,850 1,362
55
56N.P.B.F.E
34,667 36,460 219,989 226,905 (6,916)
57
58BANK CHARGES75 90 365 405 (40)
59INTEREST CHARGES158 160 748 810 (62)
60ADMINISTRATION EXPENSES
233 250 1,113 1,215 (102)
61
62TOTAL EXPENSES
75,871 80,529 831,397 790,133 41,264
63
64
N. P & L
34,434 36,210 218,876 225,690 (6,814)

<colgroup><col style="mso-width-source:userset;mso-width-alt:768;width:16pt" width="22"> <col style="mso-width-source:userset;mso-width-alt:6769;width:143pt" width="190"> <col style="mso-width-source:userset;mso-width-alt:2190;width:46pt" width="62"> <col style="mso-width-source:userset;mso-width-alt:1251;width:26pt" width="35"> <col style="mso-width-source:userset;mso-width-alt:2019;width:43pt" width="57"> <col style="mso-width-source:userset;mso-width-alt:1166;width:25pt" width="33"> <col style="mso-width-source:userset;mso-width-alt:2076;width:44pt" width="58"> <col style="mso-width-source:userset;mso-width-alt:967;width:20pt" width="27"> <col style="mso-width-source:userset;mso-width-alt:2616;width:55pt" width="74"> <col style="mso-width-source:userset;mso-width-alt:881;width:19pt" width="25"> <col style="mso-width-source:userset;mso-width-alt:1991;width:42pt" width="56"> <col style="mso-width-source:userset;mso-width-alt:1336;width:28pt" width="38"> </colgroup><tbody>
</tbody>
 
Upvote 0
Give this a Try:-
NB:- I assumed the data starts at row 40.
Code:
[COLOR="Navy"]Sub[/COLOR] MG24Aug42
im Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Nams [COLOR="Navy"]As[/COLOR] Variant, nRng [COLOR="Navy"]As[/COLOR] Range, R [COLOR="Navy"]As[/COLOR] Range, Rw [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range("A40", Range("A" & Rows.Count).End(xlUp))
Nams = Array("TOTAL OPERATING EXP.", "COST OF SALES", "DIRECT EXPENSES", "FIXED EXPENSES", "ADMINISTRATION EXPENSES", "SUNDRY ACCOUNTS", "SUNDRY INCOME", "SUNDRY EXPENSES", "MISCELLENEOUS")
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
    [COLOR="Navy"]For[/COLOR] n = 0 To UBound(Nams): .Item(Nams(n)) = Empty: [COLOR="Navy"]Next[/COLOR]
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
        [COLOR="Navy"]If[/COLOR] .exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Set[/COLOR] nRng = Dn Else [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, Dn)
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Dn
 
    ReDim Ray(1 To 10)
    Ray(1) = "Total Expences"
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] nRng
            [COLOR="Navy"]For[/COLOR] n = 2 To 10 [COLOR="Navy"]Step[/COLOR] 2
                Ray(n) = Ray(n) + R.Offset(, n - 1).Value
            [COLOR="Navy"]Next[/COLOR] n
        [COLOR="Navy"]Set[/COLOR] Rw = R
        [COLOR="Navy"]Next[/COLOR] R
[COLOR="Navy"]End[/COLOR] With

[COLOR="Navy"]With[/COLOR] Rw.Offset(2)
    .EntireRow.Insert
         [COLOR="Navy"]With[/COLOR] .Resize(, UBound(Ray))
            .Value = Ray
            .Font.Color = vbRed
            .NumberFormat = "#,##0"
        [COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Thank u Mick. It works perfect now. Many thanks also for your time spent for my project. Hv a great day
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,251
Members
448,556
Latest member
peterhess2002

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