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!
<tbody>
</tbody>
<tbody>
</tbody>
<tbody>
</tbody>
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!
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!
| BEFORE (Month 1 Summary) | ||||||
| Month | Day | Vendor | Amount | Category | Subcategory | Notes |
| 1 | 1 | CVS | $5.00 | Cat 1 | Subcat 1 | Tem1 |
| 1 | 1 | Home Depot | $10.00 | Cat 1 | Subcat 2 | Tem2 |
| 1 | 2 | McDonald's | $15.00 | Cat 1 | Subcat 3 | Tem3 |
| 1 | 3 | CVS | $20.00 | Cat 2 | Subcat 1 | Tem4 |
| 1 | 4 | Home Depot | $25.00 | Cat 2 | Subcat 2 | Tem5 |
<tbody>
</tbody>
| BEFORE (Month 2 Summary) | ||||||
| Month | Day | Vendor | Amount | Category | Subcategory | Notes |
| 2 | 1 | CVS | $30.00 | Cat 1 | Subcat 1 | Tem6 |
| 2 | 1 | Home Depot | $35.00 | Cat 1 | Subcat 2 | Tem7 |
| 2 | 2 | McDonald's | $40.00 | Cat 1 | Subcat 3 | Tem8 |
| 2 | 3 | CVS | $45.00 | Cat 2 | Subcat 1 | Tem9 |
| 2 | 4 | Home Depot | $50.00 | Cat 2 | Subcat 2 | Tem10 |
<tbody>
</tbody>
| AFTER (Category Summary) | |||
| Date | Notes | Amount | |
| CVS | |||
| 1/1 | Tem1 | $5.00 | |
| 1/3 | Tem4 | $30.00 | |
| 2/1 | Tem6 | $30.00 | |
| 2/3 | Tem9 | $45.00 | |
| etc. |
<tbody>
</tbody>
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
