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, description (vendor), cost, category, and subcategory. I am looking to have them sorted by the date based upon their description (vendor), and to display the original date, description, and cost of the data which belongs to the particular vendor.
This code is the code I am attempting to use:
I am receiving a type mismatch for the following line:
I am unsure how to proceed, and any guidance would be appreciated. Thank you!
I am attempting to generate an organized list of all entries from multiple sheets which have a date, description (vendor), cost, category, and subcategory. I am looking to have them sorted by the date based upon their description (vendor), and to display the original date, description, and cost of the data which belongs to the particular vendor.
This code is the code I am attempting to use:
Code:
Option Explicit
Private Sub CommandButton1_Click()
Dim Dic As Object
Dim Rng1 As Range, Rng2 As Range, Rng3 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 cc 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
Dim Ray2 As Variant
Dim VendList As Variant
Dim Val 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)
Ray2 = 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) * 4, 1 To 4)
Ray(1, 1) = "Vendor": Ray(1, 2) = "Date": Ray(1, 3) = "Description": Ray(1, 4) = "Amount"
For Each k In Dic.Keys
For Each p In Dic(k).Keys
For Each G In Dic(k)(p).Keys
c = c + 1
Ray(c, 1) = G
Next G
Next p
Next k
With Sheets("Category Summary").Range("A1: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
Sheets("Category Summary").Range("A1:A" & c).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Sheets("Category Summary").Range("F1"), Unique:=True
With Sheets("Category Summary").Range("A1").Resize(c, 3)
.Parent.Range("A2:D" & c).ClearContents
End With
With Sheets("Category Summary")
Set Rng3 = .Range("F2", .Range("F" & Rows.Count).End(xlUp))
End With
ReDim Ray2(1 To (Rng1.Count + Rng2.Count) * 4, 1 To 4)
Ray2(1, 1) = "Vendor": Ray2(1, 2) = "Date": Ray2(1, 3) = "Description": Ray2(1, 4) = "Amount"
cc = 1
For G = 1 To Rng3.Rows.Count
cc = cc + 1
Ray2(cc, 1) = Rng3(G)
For Each k In Dic.Keys
cc = cc + 1
Ray2(cc, 2) = k
For Each p In Dic(k).Keys
cc = cc + 1
Ray2(cc, 3) = p
If Dic(k)(p).Item(Rng3(G))(1) > 0 Then
For R = 1 To Dic(k)(p).Item(Rng3(G))(1)
cc = cc + 1
Dt = DateSerial("2017", Dic(k)(p).Item(Rng3(G))(0)(R, 1), Dic(k)(p).Item(Rng3(G))(0)(R, 2))
Ray2(cc, 4) = Format(Dt, "MMM/dd/yyyy")
Ray2(cc, 5) = k
Ray2(cc, 6) = Dic(k)(p).Item(Rng3(G))(0)(R, 3)
Next R
cc = cc + 1
End If
Next p
Next k
Next G
End Sub
Code:
Dic(k)(p).Item(Rng3(G))(1) > 0 Then
I am unsure how to proceed, and any guidance would be appreciated. Thank you!