Nested Loops in VBA

C

chriscorpion786

Board Regular
Joined
Apr 3, 2011
Messages
108
Office Version
  1. 365
Platform
  1. Windows
Dear All,

I have data as per below and I want to make a summary in VBA, like the table on the right side in bold, which shows by Name,
by category the values sold and it should be by month, but my dates are as per below, so if i have January then it should be 31 columns. I have tried 4 nested loops, one to loop for all the names, and within this another loop to go through categories and another loop to go from 1 to 31 columns, but the macro takes too long.

Is there an optimization code that you could help with and how to go about it. I have dates running across columns for each day and I need to make a report for each month similar to the right table. VBA help required please.

NameCategoryPrice1/1/20181/2/20181/3/20181/4/2018 Name Chocolate Pastries Cakes
ChrisPastries822112211 Chris 280.0 528.0 608.0
MikePastries827292313 Mike 756.0 3,043.0 441.0
AlanCakes530112029 Alan 816.0 504.0 1,138.0
DavisCakes630222029 Davis 720.0 370.0 606.0
EvaChocolate529231127 Eva 982.0 525.0 816.0
AlanChocolate820282529
MikePastries911121418
MikePastries820282529
EvaCakes820282529
AlanPastries617302314
MikePastries615251523

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

<tbody>
</tbody>

Appreciate the help.

Mustafa
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
Sort by date Sort by votes
Hi Mustafa,

I have just added a column for total & made a pivot table & got the below results ... I got some differences in some of the totals compared to your results which I don't know why. Wouldn't that approach serve your need ?

Name --- Chocolate --- Pastries --- Cakes
Chris ------- 0 ----------- 528 -------- 0
Mike ------- 0 ----------- 2515 ------- 0
Alan ------ 816 ---------- 504 ------- 450
Davis ------ 0 ------------ 0 --------- 606
Eva ------ 450 ----------- 0 --------- 816

Sorry don't know how to post an excel table, if someone can share a link with instructions, I would appreciate it
 
Upvote 0
There are some tools available here to help post data to the board & a test board where you try them out
 
Upvote 0
Hi, I was looking for a VBA solution, I have done it before with formulas, but it makes the workbook too heavy, hence wanted to try a VBA solution.
 
Upvote 0
Try this for results on sheet2.
NB:- The code assumes there are just one month worth of days in columns data,
and the results are the sum of days values Multiplied by "Price"


Code: 
[COLOR="Navy"]Sub[/COLOR] MG11May36
[COLOR="Navy"]Dim[/COLOR] Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object, col [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] aSum [COLOR="Navy"]As[/COLOR] Double, nSum [COLOR="Navy"]As[/COLOR] Double
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant
 Ray = ActiveSheet.Cells(1).CurrentRegion
 
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1
   [COLOR="Navy"]For[/COLOR] n = 2 To UBound(Ray, 1)
       [COLOR="Navy"]If[/COLOR] Not .exists(Ray(n, 2)) [COLOR="Navy"]Then[/COLOR]
           col = col + 1: .Item(Ray(n, 2)) = col
       [COLOR="Navy"]End[/COLOR] If
        nSum = 0: aSum = 0
            
            [COLOR="Navy"]If[/COLOR] Not Dic.exists(Ray(n, 1)) [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]Set[/COLOR] Dic(Ray(n, 1)) = CreateObject("Scripting.Dictionary")
            [COLOR="Navy"]End[/COLOR] If
       
            [COLOR="Navy"]If[/COLOR] Not Dic(Ray(n, 1)).exists(Ray(n, 2)) [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]For[/COLOR] Ac = 4 To UBound(Ray, 2)
                aSum = aSum + Ray(n, Ac)
                [COLOR="Navy"]Next[/COLOR] Ac
                nSum = aSum * Ray(n, 3)
                Dic(Ray(n, 1)).Add (Ray(n, 2)), nSum
            [COLOR="Navy"]Else[/COLOR]
                [COLOR="Navy"]For[/COLOR] Ac = 4 To UBound(Ray, 2)
                    aSum = aSum + Ray(n, Ac)
                [COLOR="Navy"]Next[/COLOR] Ac
                nSum = aSum * Ray(n, 3)
                Dic(Ray(n, 1)).Item(Ray(n, 2)) = Dic(Ray(n, 1)).Item(Ray(n, 2)) + nSum
            [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] n
   
   [COLOR="Navy"]Dim[/COLOR] k [COLOR="Navy"]As[/COLOR] Variant, p [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
   Ac = 1: c = 1
   ReDim nRay(1 To UBound(Ray, 1), 1 To .Count + 2)
   nRay(1, 1) = "Name"
    
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] .keys: Ac = Ac + 1: nRay(1, Ac) = k: [COLOR="Navy"]Next[/COLOR] k
            [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] Dic.keys
                c = c + 1
                nRay(c, 1) = k
                    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] p [COLOR="Navy"]In[/COLOR] Dic(k)
                        nRay(c, .Item(p) + 1) = Dic(k).Item(p)
                    [COLOR="Navy"]Next[/COLOR] p
            [COLOR="Navy"]Next[/COLOR] k

[COLOR="Navy"]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, .Count + 1)
    .Value = nRay
    .Columns.AutoFit
    .Borders.Weight = 2
[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
Hi Mick, thanks for the code.
This is what i was looking for, although i didn't know that this could be done using a dictionary in VBA.
It'll take me some time to understand the code, although I have a fair bit of understanding this code.
Would you be kind enough to put in some brief comments on what the code is accomplishing.

Thanks once again.
 
Upvote 0
This may Help Understanding !!!
Code: 
[COLOR="Navy"]Sub[/COLOR] MG15May02
[COLOR="Navy"]Dim[/COLOR] Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object, col [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] aSum [COLOR="Navy"]As[/COLOR] Double, nSum [COLOR="Navy"]As[/COLOR] Double
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant
 Ray = ActiveSheet.Cells(1).CurrentRegion
 
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1
   [COLOR="Navy"]For[/COLOR] n = 2 To UBound(Ray, 1)
       
    '[COLOR="Green"][B]##########'Give Column numbers for Unique "Categories" For use in Results Data.[/B][/COLOR]
       [COLOR="Navy"]If[/COLOR] Not .exists(Ray(n, 2)) [COLOR="Navy"]Then[/COLOR]
           col = col + 1: .Item(Ray(n, 2)) = col
       [COLOR="Navy"]End[/COLOR] If
       '[COLOR="Green"][B]#########[/B][/COLOR]
        
        nSum = 0: aSum = 0
        
     '[COLOR="Green"][B]#############'Create Individual Dictionaries for "Names" in column"A"[/B][/COLOR]
            [COLOR="Navy"]If[/COLOR] Not Dic.exists(Ray(n, 1)) [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]Set[/COLOR] Dic(Ray(n, 1)) = CreateObject("Scripting.Dictionary")
            [COLOR="Navy"]End[/COLOR] If
       '[COLOR="Green"][B]##########[/B][/COLOR]
            
          
     '[COLOR="Green"][B]##########'Add all values for Month date Headers for Individual "Names"[/B][/COLOR]
         '[COLOR="Green"][B]Dictionaries, plus their "Keys" (Categories) to get the "Items" of "Names"[/B][/COLOR]
         '[COLOR="Green"][B]Dictionary", Which are the sums Of column Date values Times the "Price"[/B][/COLOR]
            
            [COLOR="Navy"]If[/COLOR] Not Dic(Ray(n, 1)).exists(Ray(n, 2)) [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]For[/COLOR] Ac = 4 To UBound(Ray, 2)
                aSum = aSum + Ray(n, Ac)
                [COLOR="Navy"]Next[/COLOR] Ac
                nSum = aSum * Ray(n, 3)
                Dic(Ray(n, 1)).Add (Ray(n, 2)), nSum
            [COLOR="Navy"]Else[/COLOR]
                [COLOR="Navy"]For[/COLOR] Ac = 4 To UBound(Ray, 2)
                    aSum = aSum + Ray(n, Ac)
                [COLOR="Navy"]Next[/COLOR] Ac
                nSum = aSum * Ray(n, 3)
                Dic(Ray(n, 1)).Item(Ray(n, 2)) = Dic(Ray(n, 1)).Item(Ray(n, 2)) + nSum
            [COLOR="Navy"]End[/COLOR] If
    
    
    [COLOR="Navy"]Next[/COLOR] n
   
   [COLOR="Navy"]Dim[/COLOR] k [COLOR="Navy"]As[/COLOR] Variant, p [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
   Ac = 1: c = 1
   
 '[COLOR="Green"][B]#### 'Create Array for results[/B][/COLOR]
   ReDim nRay(1 To UBound(Ray, 1), 1 To .Count + 2)
   '[COLOR="Green"][B]#####[/B][/COLOR]
   
   nRay(1, 1) = "Name"
    
    
    '[COLOR="Green"][B]##### 'Loop through First Dictionary to give "Category" headers to Array "nRay"[/B][/COLOR]
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] .keys: Ac = Ac + 1: nRay(1, Ac) = k: [COLOR="Navy"]Next[/COLOR] k
        '[COLOR="Green"][B]#########[/B][/COLOR]
            
            
      '[COLOR="Green"][B]#####'Loop through Dic of Dictionaries To place the names and the Individual "Sums"[/B][/COLOR]
          '[COLOR="Green"][B]agains the appropriate Header "Catergories"[/B][/COLOR]
            [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] Dic.keys
                c = c + 1
                nRay(c, 1) = k
                    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] p [COLOR="Navy"]In[/COLOR] Dic(k)
                        nRay(c, .Item(p) + 1) = Dic(k).Item(p)
                    [COLOR="Navy"]Next[/COLOR] p
            [COLOR="Navy"]Next[/COLOR] k
          '[COLOR="Green"][B]###########[/B][/COLOR]
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, .Count + 1)
    .Value = nRay
    .Columns.AutoFit
    .Borders.Weight = 2
[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
You must log in or register to reply here.

Similar threads

imback2nite
  • Solved
VBA help.
2
Replies
10
Views
385
Peter_SSs
Peter_SSs
S
  • Locked
  • Question
Add new row by looping column (Scripting Dictionary)
Replies
5
Views
147
Peter_SSs
Peter_SSs
A
  • Question
VBA Highlight cell if contains specific text
Replies
4
Views
219
DanteAmor
DanteAmor
M
  • Locked
  • Question
Alternative to nested If
Replies
1
Views
282
Joe4
Joe4
M
  • Solved
Alternative to nested IF Formula
2
Replies
11
Views
903
Fluff
Fluff

Forum statistics

Threads
1,215,419
Messages
6,124,796
Members
449,189
Latest member
kristinh

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