Issue With Proceeding Only if Object Exists

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:

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
I am receiving a type mismatch for the following line:

Code:
Dic(k)(p).Item(Rng3(G))(1) > 0 Then

I am unsure how to proceed, and any guidance would be appreciated. Thank you!
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
I am receiving a type mismatch for the following line:

Dic(k)(p).Item(Rng3(G))(1) > 0 Then

My guess is that .Item(Rng3(G)) doesn't exist for Dic(k)(p), so you'll get a type mismatch error if you try to get its 1-th element.

What's the value of Rng3(G) when the code errors?

Based on your code, it looks like this means there's a value in Column F of "Category Summary" that hasn't occurred in column F of "Month 1 Summary" or "Month 2 Summary"?

I'm not sure if that's the problem - your heading implies that you only want to proceed if the item exists, in which case can't you simply test:

If dic(k)(p).exists(Rng3(G)) Then ....
 
Upvote 0

Forum statistics

Threads
1,213,506
Messages
6,114,027
Members
448,543
Latest member
MartinLarkin

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