Nested Loops in VBA

C

chriscorpion786

Board Regular
Joined
Apr 3, 2011
Messages
112
Office Version
  1. 365
Platform
  1. Windows
[TABLE="width: 64"]
<tbody>[TR]
[TD="width: 64"]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.

[TABLE="width: 898"]
<colgroup><col><col><col><col span="4"><col><col span="4"></colgroup><tbody>[TR]
[TD]Name[/TD]
[TD]Category[/TD]
[TD]Price[/TD]
[TD]1/1/2018[/TD]
[TD]1/2/2018[/TD]
[TD]1/3/2018[/TD]
[TD]1/4/2018[/TD]
[TD][/TD]
[TD] Name [/TD]
[TD] Chocolate [/TD]
[TD] Pastries [/TD]
[TD] Cakes [/TD]
[/TR]
[TR]
[TD]Chris[/TD]
[TD]Pastries[/TD]
[TD="align: right"]8[/TD]
[TD]22[/TD]
[TD]11[/TD]
[TD]22[/TD]
[TD]11[/TD]
[TD][/TD]
[TD] Chris [/TD]
[TD] 280.0[/TD]
[TD] 528.0[/TD]
[TD] 608.0[/TD]
[/TR]
[TR]
[TD]Mike[/TD]
[TD]Pastries[/TD]
[TD="align: right"]8[/TD]
[TD]27[/TD]
[TD]29[/TD]
[TD]23[/TD]
[TD]13[/TD]
[TD][/TD]
[TD] Mike [/TD]
[TD] 756.0[/TD]
[TD] 3,043.0[/TD]
[TD] 441.0[/TD]
[/TR]
[TR]
[TD]Alan[/TD]
[TD]Cakes[/TD]
[TD="align: right"]5[/TD]
[TD]30[/TD]
[TD]11[/TD]
[TD]20[/TD]
[TD]29[/TD]
[TD][/TD]
[TD] Alan [/TD]
[TD] 816.0[/TD]
[TD] 504.0[/TD]
[TD] 1,138.0[/TD]
[/TR]
[TR]
[TD]Davis[/TD]
[TD]Cakes[/TD]
[TD="align: right"]6[/TD]
[TD]30[/TD]
[TD]22[/TD]
[TD]20[/TD]
[TD]29[/TD]
[TD][/TD]
[TD] Davis [/TD]
[TD] 720.0[/TD]
[TD] 370.0[/TD]
[TD] 606.0[/TD]
[/TR]
[TR]
[TD]Eva[/TD]
[TD]Chocolate[/TD]
[TD="align: right"]5[/TD]
[TD]29[/TD]
[TD]23[/TD]
[TD]11[/TD]
[TD]27[/TD]
[TD][/TD]
[TD] Eva [/TD]
[TD] 982.0[/TD]
[TD] 525.0[/TD]
[TD] 816.0[/TD]
[/TR]
[TR]
[TD]Alan[/TD]
[TD]Chocolate[/TD]
[TD="align: right"]8[/TD]
[TD]20[/TD]
[TD]28[/TD]
[TD]25[/TD]
[TD]29[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Mike[/TD]
[TD]Pastries[/TD]
[TD="align: right"]9[/TD]
[TD]11[/TD]
[TD]12[/TD]
[TD]14[/TD]
[TD]18[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Mike[/TD]
[TD]Pastries[/TD]
[TD="align: right"]8[/TD]
[TD]20[/TD]
[TD]28[/TD]
[TD]25[/TD]
[TD]29[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Eva[/TD]
[TD]Cakes[/TD]
[TD="align: right"]8[/TD]
[TD]20[/TD]
[TD]28[/TD]
[TD]25[/TD]
[TD]29[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Alan[/TD]
[TD]Pastries[/TD]
[TD="align: right"]6[/TD]
[TD]17[/TD]
[TD]30[/TD]
[TD]23[/TD]
[TD]14[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Mike[/TD]
[TD]Pastries[/TD]
[TD="align: right"]6[/TD]
[TD]15[/TD]
[TD]25[/TD]
[TD]15[/TD]
[TD]23[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]

Appreciate the help.

Mustafa
 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
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

V
  • Solved
Show duplicates from across multiple ranges in one cell with a single nested formula?
Replies
9
Views
188
VikingLink
V
S
  • Question Question
Macro to change one cell on a sheet, save sheet as PDF, then loop back and change that one cell on that sheet and repeat until the end
Replies
3
Views
680
IslandofBDA
I
imback2nite
  • Solved
VBA help.
2
Replies
10
Views
803
Peter_SSs
Peter_SSs
R
  • Question Question
Highlighting cells based on criteria
Replies
0
Views
443
rahildhody
R
M
  • Solved
Loop set of 3, within 5 results
2
Replies
11
Views
464
Phuoc
P

Forum statistics

Threads
1,224,823
Messages
6,181,175
Members
453,021
Latest member
Justyna P

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