Sorting Data from Multiple Pages by Date Based on Description

M

Mlwhiteman

New Member
Joined
Nov 26, 2017
Messages
12
Hello,

I am attempting to generate an organized list of all entries from multiple sheets which have a date, vendor, cost, category, subcategory, and notes. I am looking to have them sorted by date based upon their vendor, and to display the original date, notes, and cost of the data which belongs to the particular vendor. I have three (3) worksheets for this example: Worksheet #1 : (Month 1 Summary), Worksheet #2 : (Month 2 Summary), and Worksheet #3 (Category Summary). Worksheets #1 and #2 are how the data is currently organized, and Worksheet #3 is the desired result. I am assuming that the header for "Month" begins in cell A1. Any help would be appreciated. Thanks!

[TABLE="class: cms_table, width: 482"]
<tbody>[TR]
[TD="colspan: 7"]BEFORE (Month 1 Summary)[/TD]
[/TR]
[TR]
[TD]Month[/TD]
[TD]Day[/TD]
[TD]Vendor[/TD]
[TD]Amount[/TD]
[TD]Category[/TD]
[TD]Subcategory[/TD]
[TD]Notes[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]1[/TD]
[TD]CVS[/TD]
[TD]$5.00[/TD]
[TD]Cat 1[/TD]
[TD]Subcat 1[/TD]
[TD]Tem1[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]1[/TD]
[TD]Home Depot[/TD]
[TD]$10.00[/TD]
[TD]Cat 1[/TD]
[TD]Subcat 2[/TD]
[TD]Tem2[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]2[/TD]
[TD]McDonald's[/TD]
[TD]$15.00[/TD]
[TD]Cat 1[/TD]
[TD]Subcat 3[/TD]
[TD]Tem3[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]3[/TD]
[TD]CVS[/TD]
[TD]$20.00[/TD]
[TD]Cat 2[/TD]
[TD]Subcat 1[/TD]
[TD]Tem4[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]4[/TD]
[TD]Home Depot[/TD]
[TD]$25.00[/TD]
[TD]Cat 2[/TD]
[TD]Subcat 2[/TD]
[TD]Tem5[/TD]
[/TR]
</tbody>[/TABLE]


[TABLE="class: cms_table, width: 482"]
<tbody>[TR]
[TD="colspan: 7"]BEFORE (Month 2 Summary)[/TD]
[/TR]
[TR]
[TD]Month[/TD]
[TD]Day[/TD]
[TD]Vendor[/TD]
[TD]Amount[/TD]
[TD]Category[/TD]
[TD]Subcategory[/TD]
[TD]Notes[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]1[/TD]
[TD]CVS[/TD]
[TD]$30.00[/TD]
[TD]Cat 1[/TD]
[TD]Subcat 1[/TD]
[TD]Tem6[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]1[/TD]
[TD]Home Depot[/TD]
[TD]$35.00[/TD]
[TD]Cat 1[/TD]
[TD]Subcat 2[/TD]
[TD]Tem7[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]2[/TD]
[TD]McDonald's[/TD]
[TD]$40.00[/TD]
[TD]Cat 1[/TD]
[TD]Subcat 3[/TD]
[TD]Tem8[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]3[/TD]
[TD]CVS[/TD]
[TD]$45.00[/TD]
[TD]Cat 2[/TD]
[TD]Subcat 1[/TD]
[TD]Tem9[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]4[/TD]
[TD]Home Depot[/TD]
[TD]$50.00[/TD]
[TD]Cat 2[/TD]
[TD]Subcat 2[/TD]
[TD]Tem10[/TD]
[/TR]
</tbody>[/TABLE]


[TABLE="class: cms_table, width: 234"]
<tbody>[TR]
[TD="colspan: 4"]AFTER (Category Summary)[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Date[/TD]
[TD]Notes[/TD]
[TD]Amount[/TD]
[/TR]
[TR]
[TD]CVS[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]1/1[/TD]
[TD]Tem1[/TD]
[TD]$5.00[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]1/3[/TD]
[TD]Tem4[/TD]
[TD]$30.00[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]2/1[/TD]
[TD]Tem6[/TD]
[TD]$30.00[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]2/3[/TD]
[TD]Tem9[/TD]
[TD]$45.00[/TD]
[/TR]
[TR]
[TD]etc.


[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Below is code which is similar, but organized the data by category and subcategory rather than vendor. I believe that all that has to be done is reallocate the fields within the dictionary but I'm unsure how to do that exactly. Any help would be appreciated! Thanks!

Code: 
Option Explicit


Private Sub CommandButton1_Click()
Dim Dic         As Object
Dim Rng1        As Range, Rng2 As Range
Dim Rng         As Range, Dn As Range
Dim k           As Variant
Dim p           As Variant
Dim G           As Variant
Dim c           As Long
Dim Q           As Variant
Dim R           As Long
Dim Ac          As Integer
Dim n           As Long
Dim Dt          As Date
Dim Ray         As Variant
With Sheets("Month 1 Summary")
    Set Rng1 = .Range("F6", .Range("F" & Rows.Count).End(xlUp))
End With
With Sheets("Month 2 Summary")
    Set Rng2 = .Range("F6", .Range("F" & Rows.Count).End(xlUp))
End With
Ray = Array(Rng1, Rng2)


Set Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1
   For Ac = 0 To 1
    For Each Dn In Ray(Ac)
    If Not Dic.exists(Dn.Value) Then
            Set Dic(Dn.Value) = CreateObject("Scripting.Dictionary")
        End If
            
            If Not Dic(Dn.Value).exists(Dn.Offset(, 1).Value) Then
                Set Dic(Dn.Value)(Dn.Offset(, 1).Value) = CreateObject("Scripting.Dictionary")
                    Dic(Dn.Value)(Dn.Offset(, 1).Value).CompareMode = 1
            End If
              If Not Dic(Dn.Value)(Dn.Offset(, 1).Value).exists(Dn.Offset(, -2).Value) Then
                   
                    ReDim nRay(1 To Rng1.Count + Rng2.Count, 1 To 3)
                    nRay(1, 1) = Dn.Offset(, -4).Value
                    nRay(1, 2) = Dn.Offset(, -3).Value
                    nRay(1, 3) = Dn.Offset(, -1).Value
                    Dic(Dn.Value)(Dn.Offset(, 1).Value).Add (Dn.Offset(, -2).Value), Array(nRay, 1)
             Else
                Q = Dic(Dn.Value)(Dn.Offset(, 1).Value).Item(Dn.Offset(, -2).Value)
                    Q(1) = Q(1) + 1
                    Q(0)(Q(1), 1) = Dn.Offset(, -4)
                    Q(0)(Q(1), 2) = Dn.Offset(, -3)
                    Q(0)(Q(1), 3) = Dn.Offset(, -1)
                Dic(Dn.Value)(Dn.Offset(, 1).Value).Item(Dn.Offset(, -2).Value) = Q
 
            End If
    Next Dn
 Next Ac
c = 1
ReDim Ray(1 To (Rng1.Count + Rng2.Count) * 3, 1 To 4)
Ray(1, 2) = "Date": Ray(1, 3) = "Description": Ray(1, 4) = "Amount"
For Each k In Dic.Keys
           c = c + 1
           Ray(c, 1) = k
        For Each p In Dic(k).Keys
                c = c + 1
                Ray(c, 2) = p
            For Each G In Dic(k)(p).Keys
               
                For R = 1 To Dic(k)(p).Item(G)(1)
                    c = c + 1
                    Dt = DateSerial("2017", Dic(k)(p).Item(G)(0)(R, 1), Dic(k)(p).Item(G)(0)(R, 2))
                    Ray(c, 2) = Format(Dt, "MMM/dd/yyyy")
                    Ray(c, 3) = G
                    Ray(c, 4) = Dic(k)(p).Item(G)(0)(R, 3)
                Next R
            Next G
            c = c + 1
        Next p
Next k


With Sheets("Category Summary").Range("B1:D1")
    .Font.Bold = True
    .HorizontalAlignment = xlCenter
End With


With Sheets("Category Summary").Range("A1").Resize(c, 4)
    .Parent.Range("A:D").ClearContents
    .Value = Ray
    .Borders.Weight = 2
    .Columns.AutoFit
End With    
End Sub
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
Sort by date Sort by votes
Try this for Results on Sheet "Category Summary"
NB:- Any sheet with the first word in the sheet name being "Month" will be taken into account for the Results.
Code: 
[COLOR="Navy"]Sub[/COLOR] MG12Jan14
[COLOR="Navy"]Dim[/COLOR] Ws [COLOR="Navy"]As[/COLOR] Worksheet, R [COLOR="Navy"]As[/COLOR] Variant, Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
            Dic.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Ws [COLOR="Navy"]In[/COLOR] Worksheets
    R = Ws.Cells(1).CurrentRegion.Resize(, 7)
    [COLOR="Navy"]If[/COLOR] Left(Ws.Name, 5) = "Month" [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]For[/COLOR] n = 2 To UBound(R, 1)
                [COLOR="Navy"]If[/COLOR] Not Dic.Exists(R(n, 3)) [COLOR="Navy"]Then[/COLOR]
                    ReDim Ray(1 To 3, 1 To 1)
                        Ray(1, 1) = Format(DateSerial(Year(Now), R(n, 1), R(n, 2)), "dd-mmm")
                        Ray(2, 1) = R(n, 7)
                        Ray(3, 1) = R(n, 4)
                    Dic.Add R(n, 3), Ray
               [COLOR="Navy"]Else[/COLOR]
                Q = Dic(R(n, 3))
                    ReDim Preserve Q(1 To 3, 1 To UBound(Q, 2) + 1)
                        Q(1, UBound(Q, 2)) = Format(DateSerial(Year(Now), R(n, 1), R(n, 2)), "dd-mmm")
                        Q(2, UBound(Q, 2)) = R(n, 7)
                        Q(3, UBound(Q, 2)) = R(n, 4)
                Dic(R(n, 3)) = Q
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] n
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Ws
[COLOR="Navy"]Dim[/COLOR] c       [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] k       [COLOR="Navy"]As[/COLOR] Variant
c = 2

[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] Dic.Keys
  [COLOR="Navy"]With[/COLOR] Sheets("Category Summary")
    .Columns.AutoFit
    .Range("A1").Resize(, 4).Value = Array("Vendor", "Date", "Notes", "Amount")
    .Cells(c, "A") = k
    c = c + 1
    .Cells(c, "B").Resize(UBound(Dic(k), 2), 3) = Application.Transpose(Dic(k))
    c = c + UBound(Dic(k), 2) + 1
    [COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Next[/COLOR] k
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
You must log in or register to reply here.

Similar threads

montecarlo2012
  • Solved
vba=Loop through each row in the data range.(B2:F10000)
Replies
9
Views
2K
montecarlo2012
montecarlo2012
P
  • Question Question
Populating, aggregating and sorting multiple matching values in Excel
Replies
0
Views
182
Pbobas
P
montecarlo2012
  • Solved
Read sheet 3 results on sheet 1
Replies
4
Views
628
montecarlo2012
montecarlo2012
T
  • Question Question
List data horizontally from table based on date
Replies
3
Views
256
alansidman
A
montecarlo2012
  • Question Question
25 minutes code, skip report.
Replies
5
Views
632
BSALV
BSALV

Forum statistics

Threads
1,223,157
Messages
6,170,419
Members
452,325
Latest member
BlahQz

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