VBA - Dictionary ERROR *worked before, changed import and now doesn't work

RCBricker

Well-known Member
Joined
Feb 4, 2003
Messages
1,560
Hi all. I have the below code which is now throwing an error. The code worked fine when I finished the DB, but management asked for changes in the import process (wanted it handled automatically). So I wrote the code to import the data sets. I used the chance to standardize the data a little and have made changes to which fields should be looked for. I am now testing the new import code (works great) and wanted to run the process on a new data set. that is when I found out that this procedure is no longer running.

I get a compile error:
User-Defined type not defined
The debugger highlights the row that declares my dictionary variables (dicD & dicF)

Code:
Private Sub VCode(strFEED As String, strLIMIT As String, LrowW As Long, _
                    cellADD As Range)
Dim LngROWD As Long, LngROWF As Long, LngCOLD As Long, LngCOLF As Long, lngROW As Long, _
    LngROWDC As Long, LngrowFC As Long

Dim rngHD As Range, rngHF As Range, cellD As Range, cellF As Range, rng As Range, _
    rngAMTD As Range, rngAMTF As Range, rngADD As Range
Dim dicD As Dictionary, dicF As Dictionary
Dim varDICD As Variant, varDICF As Variant  'Dictionary element variants
Dim shDCAS As Worksheet, shFEED As Worksheet, shVAR As Worksheet, shSUM As Worksheet
Dim varFSD As Variant, varFSF As Variant, varMATD As Variant, varMATF As Variant, _
    varLMTD As Variant, varLMTF As Variant, varAMTD1 As Variant, varAMTF1 As Variant, _
    varI As Variant, varAMTD2 As Variant, varAMTF2 As Variant, varJ As Variant, _
    varH As Variant
Dim strSYS As String
Dim keyD As Variant, keyF As Variant, keyV As Variant

On Error GoTo ErrCapture

1401    Set dicD = New Dictionary
1402    Set dicF = New Dictionary

1403    keyD = 1
1404    keyF = 1

1405    If LrowW = 6 Then
1406        strSYS = strFEED
1407    Else
1408        strSYS = "DAI"
1409    End If

1410    Set shDCAS = Sheets("DCAS Detail")
1411    shDCAS.AutoFilterMode = False
varH = shDCAS.Range("a1").End(xlDown).Row

1412    Set shFEED = Sheets(strSYS & " Detail")
1413    shFEED.AutoFilterMode = False
varJ = shFEED.Range("a1").End(xlDown).Row

1414    Set shVAR = Sheets("Variance")
1415    Set shSUM = Sheets(strFEED & " Summary")

1416    shFEED.Select
1417    With shFEED
1418        LngROWF = Range("A1").End(xlDown).Row
1419        LngCOLF = Cells(1, .Columns.Count).End(xlToLeft).Column
1420        Set rngHF = Range(.Cells(1, 1), .Cells(1, LngCOLF))

1421        If strSYS = "DAI" Then
1422            For Each cellF In rngHF
1423                Select Case cellF.Value
                        Case "Feeder Source"
1425                        varFSF = cellF.Column
1426                    Case "MATCHALL_QDD"
1427                        varMATF = cellF.Column
1428                    Case "LIMIT"
1429                        varLMTF = cellF.Column
1430                    Case "AMT"
1431                        varAMTF1 = cellF.Column
1432                End Select
1433            Next cellF
1434        Else
1435            For Each cellF In rngHF
1436                Select Case cellF.Value
                        Case "MATCHALL_MOCAS", "MATCHALL_IPAC", "c_MATCHALL_ONEPAY"
1438                        varMATF = cellF.Column
1439                    Case "LIMIT", "SubHead", "SUBHD"
1440                        varLMTF = cellF.Column
1441                    Case "AMT", "sAmt", "c_AMOUNT_NORMALIZED"
1442                        varAMTF1 = cellF.Column
1443                End Select
1444            Next cellF
1445        End If

1446        Set rngAMTF = .Range(.Cells(2, varAMTF1), .Cells(LngROWF, varAMTF1))

1447        If Not varFSF = vbNullString Or varFSF = "" Then
1449            rngHF.AutoFilter Field:=varFSF, Criteria1:=strFEED
1450        End If

1451        rngHF.AutoFilter Field:=varLMTF, Criteria1:=strLIMIT

shVAR.Columns.ClearContents

1452        Set rng = Range(.Cells(2, varMATF), .Cells(LngROWF, varMATF))
1453        rng.SpecialCells(xlCellTypeVisible).Copy shVAR.Range("A1")

1454        shVAR.Select
1455        With shVAR

1456            lngROW = Range("A" & .Rows.Count).End(xlUp).Row
1457            If lngROW = 1 Then
1458            Else
1459                Set rng = Range(.Cells(1, 1), .Cells(lngROW, 1))
1460                rng.RemoveDuplicates
1461                For Each cellF In rng
1462                    varI = CStr(UCase(cellF.Value))
1463                    With dicD
1464                        .CompareMode = TextCompare
1465                        If Not .Exists(varI) Then
1466                            .Add Key:=varI, Item:=keyD
1467                        End If
1468                    End With
1469                    keyD = keyD + 1
1470                Next cellF
1471                rng.Delete
1472            End If
1473        End With

1474        shDCAS.Select
1475        With shDCAS
1476            LngROWD = Range("A1").End(xlDown).Row
1477            LngCOLD = Cells(1, .Columns.Count).End(xlToLeft).Column
1478            Set rngHD = Range(.Cells(1, 1), .Cells(1, LngCOLD))

1479            For Each cellD In rngHD
1480                Select Case cellD.Value
                        Case "Feeder Source"
1482                        varFSD = cellD.Column
1483                    Case "MATCHALL_DCAS"
1484                        varMATD = cellD.Column


1485                    Case "Sub_Lim"
1486                        varLMTD = cellD.Column
1487                    Case "Trns_Amt"
1488                        varAMTD1 = cellD.Column
1489                End Select
1490            Next cellD

1491            Set rngAMTD = Range(Cells(2, varAMTD1), Cells(LngROWD, varAMTD1))

1492            If Not varFSD = vbNullString Or varFSD = "" Then
1494                rngHD.AutoFilter Field:=varFSD, Criteria1:=strFEED
1495            End If

1496            rngHD.AutoFilter Field:=varLMTD, Criteria1:=strLIMIT

shVAR.Columns.ClearContents


    Set rng = Range(.Cells(2, varMATD), .Cells(LngROWD, varMATD))






1498            rng.SpecialCells(xlCellTypeVisible).Copy shVAR.Range("A1")

1499            shVAR.Select
1500            With shVAR
1501                lngROW = Range("A" & .Rows.Count).End(xlUp).Row
1502                If lngROW = 1 Then
1503                Else
1504                    Set rng = Range(.Cells(1, 1), .Cells(lngROW, 1))
1505                    rng.RemoveDuplicates
1506                    For Each cellD In rng
1507                        varI = CStr(UCase(cellD.Value))
1508                        With dicD
1509                            .CompareMode = TextCompare
1510                            If Not .Exists(varI) Then
1511                                .Add Key:=varI, Item:=keyD
1512                            End If
1513                        End With
1514                        keyD = keyD + 1
1515                    Next cellD
1516                    rng.Delete
1517                End If
1518            End With
1519        End With

1520        For Each varI In dicD

1521            rngHF.AutoFilter Field:=varMATF, Criteria1:=varI
1522            rngHD.AutoFilter Field:=varMATD, Criteria1:=varI

On Error Resume Next
                rngAMTF.SpecialCells(xlCellTypeVisible).Interior.Color = 65535
                rngAMTD.SpecialCells(xlCellTypeVisible).Interior.Color = 65535
                
1523            varAMTD2 = WorksheetFunction.Sum(rngAMTD. _
                    SpecialCells(xlCellTypeVisible))
1524            varAMTF2 = WorksheetFunction.Sum(rngAMTF. _
                    SpecialCells(xlCellTypeVisible))
On Error GoTo ErrCapture
1525            LngROWDC = shDCAS.Cells(varH + 1, varMATD).End(xlUp).Row
1526            LngrowFC = shFEED.Cells(varJ + 1, varMATF).End(xlUp).Row

1528            If LngROWDC = 1 Or LngrowFC = 1 Then
1529                If LngROWDC = 1 Then
1530                    rngAMTF.SpecialCells(xlCellTypeVisible). _
                            Interior.Color = 65535
1531                Else
1532                    rngAMTD.SpecialCells(xlCellTypeVisible). _
                            Interior.Color = 65535
1533                End If
1534            Else
                    If shFEED.Name = "DAI Detail" Then
1535                    If varAMTD2 = varAMTF2 * -1 Then 'all are matched

1536                        rngAMTD.SpecialCells(xlCellTypeVisible). _
                                Interior.Color = 5296274
1537                        rngAMTF.SpecialCells(xlCellTypeVisible). _
                                Interior.Color = 5296274
1538                    Else    'not all are matched check each value
1539                        If LngROWDC = 1 Or LngrowFC = 1 Then
1540                            If LngROWDC = 1 Then
1541                                rngAMTF.SpecialCells(xlCellTypeVisible). _
                                        Interior.Color = 65535
1542                            Else
1543                                rngAMTD.SpecialCells(xlCellTypeVisible). _
                                        Interior.Color = 65535
1544                            End If
1545                        Else

1546                            For Each cellD In rngAMTD.SpecialCells(xlCellTypeVisible)
1547                                For Each cellF In rngAMTF.SpecialCells(xlCellTypeVisible)
1548                                    If cellD.Value = cellF.Value * -1 Then
1549                                        If cellD.Interior.Color = 5296274 Or _
                                                cellF.Interior.Color = 5296274 _
                                                Then 'if either cell _
                                                    has already been matched
                                                'do nothing
1550                                        Else    'neither cell has been matched
1551                                            cellD.Interior.Color = 5296274
1552                                            cellF.Interior.Color = 5296274
1553                                        End If
1554                                    End If
1555                                Next cellF
1556                            Next cellD
1557                        End If
1558                    End If
1560                Else
1568                    If varAMTD2 = varAMTF2 Then   'all are matched
1569                        rngAMTD.SpecialCells(xlCellTypeVisible). _
                                Interior.Color = 5296274
1570                        rngAMTF.SpecialCells(xlCellTypeVisible). _
                                Interior.Color = 5296274
1571                    Else    'not all are matched check each value
1572                        For Each cellD In rngAMTD.SpecialCells(xlCellTypeVisible)
1573                            For Each cellF In rngAMTF.SpecialCells _
                                    (xlCellTypeVisible)
1574                                If cellD.Value = cellF.Value Then
1575                                    If cellD.Interior.Color = 5296274 Or _
                                            cellF.Interior.Color = 5296274 _
                                            Then 'if either cell _
                                            has already been matched
                                            'do nothing
                                            If cellD.Interior.Color = 5296274 Then 'if either cell _
                                                has already been matched
                                                cellF.Interior.Color = 65535
                                            Else
                                                cellD.Interior.Color = 65535
                                            End If
1576                                    Else    'neither cell has been matched
1577                                        cellD.Interior.Color = 5296274
1578                                        cellF.Interior.Color = 5296274
1579                                    End If
1580                                End If
1581                            Next cellF
1582                        Next cellD
1583                    End If
1584                End If
1585            End If
1586        Next varI
1587    End With

1588    shDCAS.AutoFilterMode = False
1589    shFEED.AutoFilterMode = False
        varI = LngROWD + 5
        
1590    shDCAS.Select
1591    With shDCAS
1592        Set rng = Range(.Cells(1, 1), .Cells(LngROWD, LngCOLD))
1593        rngHD.AutoFilter Field:=varAMTD1, Criteria1:=RGB(255 _
                , 255, 0), Operator:=xlFilterCellColor
            lngROW = Cells(varH + 1, varAMTD1).End(xlUp).Row
1595        If Not lngROW = 1 Then

1597            LngROWD = Range("A" & .Rows.Count).End(xlUp).Offset(2).Row
                With Range("A" & LngROWD)
                    .Value = strSYS & " variance detail for Limit: " & strLIMIT
                    .Font.Bold = True
                    .Font.Size = "14"
                End With

1603            LngROWD = LngROWD + 1
1604            rng.SpecialCells(xlCellTypeVisible).Copy Range("A" & LngROWD)
1605            LngROWD = Range("A" & .Rows.Count).End(xlUp).Offset(2).Row
1606            Range("A" & LngROWD).Value = "Sub-Total for Limit: "
                Range("A" & LngROWD).Offset(, 1).Value = "'" & strLIMIT
1607            Range("A" & LngROWD).Offset(, 2).Value = WorksheetFunction.Sum _
                    (rngAMTD.SpecialCells(xlCellTypeVisible))

1608            shSUM.Select
1609            With shSUM
1610                If LrowW = 6 Then
1611                    varI = Range("A13").End(xlUp).Row
1612                    If varI = 6 Then
1613                        varI = 8
1614                    End If
1615                Else
1616                    varI = Range("A30").End(xlUp).Row
1617                    If varI = 18 Then
1618                        varI = 20
1619                    End If
1620                End If
1621                Range("A" & varI).Value = "Variances Explained in Detail"
1622                Set rngADD = Cells(varI, cellADD.Column)
1623                rngADD.Value = shDCAS.Range("A" & LngROWD).Offset(, 2).Value
1624                rngADD.Style = "Comma"

1626            End With

1627            shDCAS.AutoFilterMode = False
1630        End If
1631    End With



1632    If strSYS = "DAI" Then
1633        shFEED.Select
1634        With shFEED
1635            Set rng = Range(.Cells(1, 1), .Cells(LngROWF, LngCOLF))
1636            rngHF.AutoFilter Field:=varAMTF1, Criteria1:=RGB(255 _
                    , 255, 0), Operator:=xlFilterCellColor

1637            lngROW = Cells(varJ + 1, varAMTF1).End(xlUp).Row
1638            If Not lngROW = 1 Then
1640                LngROWF = Range("A" & .Rows.Count).End(xlUp).Offset(2).Row
1641                With Range("A" & LngROWF)
1642                    .Value = strSYS & " variance detail for Limit: " & strLIMIT
1643                    .Font.Bold = True
1644                    .Font.Size = "14"
1645                End With
1646                LngROWF = LngROWF + 1
1647                rng.SpecialCells(xlCellTypeVisible).Copy Range("A" & LngROWF)
1648                LngROWF = Range("A" & .Rows.Count).End(xlUp).Offset(2).Row
1649                Range("A" & LngROWF).Value = "Sub-Total for Limit: "
                    Range("A" & LngROWF).Offset(, 1).Value = "'" & strLIMIT
1650                Range("A" & LngROWF).Offset(, 2).Value = WorksheetFunction.Sum _
                        (rngAMTF.SpecialCells(xlCellTypeVisible))
1651                shSUM.Select
1652                With shSUM
1653                    If LrowW = 6 Then
1654                        varI = Range("A13").End(xlUp).Row
                            If varI = 6 Then
                                varI = 8
                            Else
                                varI = varI + 1
                            End If
                        Else
                            varI = Range("A30").End(xlUp).Row
                            If varI = 18 Then
                                varI = 20
                            Else
                                varI = varI + 1
                            End If
                        End If
                        Range("A" & varI).Value = "Variances Explained in Detail"
                        Set rngADD = Cells(varI, cellADD.Column)
                        rngADD.Value = shFEED.Range("A" & LngROWF).Offset(, 2).Value
                        rngADD.Style = "Comma"

                    End With
                End If
            End With
        Else
            shFEED.Select
            With shFEED
                Set rng = Range(.Cells(1, 1), .Cells(LngROWF, LngCOLF))
                rngHF.AutoFilter Field:=varAMTF1, Criteria1:=RGB(255 _
                , 255, 0), Operator:=xlFilterCellColor
                lngROW = Cells(varJ + 1, varAMTF1).End(xlUp).Row
                If lngROW = 1 Then
                Else
                    LngROWF = Range("A" & .Rows.Count).End(xlUp).Offset(2).Row
                    With Range("A" & LngROWF)
                        .Value = strFEED & "Variance detail for Limit: " & strLIMIT
                        .Font.Bold = True
                        .Font.Size = "14"
                    End With
                    LngROWF = LngROWF + 1
                    rng.SpecialCells(xlCellTypeVisible).Copy Range("A" & LngROWF)
                    LngROWF = Range("A" & .Rows.Count).End(xlUp).Offset(2).Row
                    Range("A" & LngROWF).Value = "Sub-Total for Limit: "
                    Range("A" & LngROWF).Value = "'" & strLIMIT
                    Range("A" & LngROWF).Offset(, 2).Value = WorksheetFunction.Sum _
                    (rngAMTF.SpecialCells(xlCellTypeVisible))
                    shSUM.Select
                    With shSUM
                        If LrowW = 6 Then
                            varI = Range("A13").End(xlUp).Row
                            If varI = 6 Then
                                varI = 8
                            End If
                        Else
                            varI = Range("A30").End(xlUp).Row
                            If varI = 18 Then
                                varI = 20
                            End If
                        End If
                        Range("A" & varI).Value = "Variances Explained in Detail"
                        Set rngADD = Cells(varI, cellADD.Column)
                        rngADD.Value = shFEED.Range("A" & LngROWF).Offset(, 2).Value
                        rngADD.Style = "Comma"

                    End With
                End If
            End With
        End If
        
        shFEED.Select
        With shFEED
            .AutoFilterMode = False
            '.Cells.Columns.AutoFit
            varI = Range("A1").End(xlDown).End(xlDown).End(xlDown).Row
            LngROWF = Range("A" & .Rows.Count).End(xlUp).Row
            If varI = .Rows.Count Then
                varI = LngROWF
            End If
            LngCOLF = Cells(1, .Columns.Count).End(xlToLeft).Column
            
            Set rng = Range(.Cells(1, 1), .Cells(varI, LngCOLF))
            rng.Columns.AutoFit
            varI = Range("A1").End(xlDown).Row
            Set rng = Range(.Cells(2, 1), .Cells(varI, LngCOLF))
            rng.Interior.Pattern = xlNone
        End With
        
        shDCAS.Select
        With shDCAS

            .AutoFilterMode = False
            '.Cells.Columns.AutoFit
            varI = Range("A1").End(xlDown).End(xlDown).End(xlDown).Row
            LngROWD = Range("A" & .Rows.Count).End(xlUp).Row
            If varI = .Rows.Count Then
                varI = LngROWD
            End If
            LngCOLD = Cells(1, .Columns.Count).End(xlToLeft).Column
            Range("A" & LngROWD).Select
            Set rng = Range(.Cells(1, 1), .Cells(varI, LngCOLD))
            rng.Columns.AutoFit
            varI = Range("A1").End(xlDown).Row
            Set rng = Range(.Cells(2, 1), .Cells(varI, LngCOLD))
            rng.Interior.Pattern = xlNone
        End With

Exit Sub

any ideas why it worked and now doesn't...better yet any ideas how to get access to get past this error?

rich
 

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.
I assume you mean here: Dim dicD As Dictionary, dicF As Dictionary
Did you switch to a different pc at some point? I suspect you do not have a reference to the Microsoft Scripting Runtime library. Lack of references is usually the cause for user defined types of errors. If you're going to use early binding (Dim as anything other than Object) I recommend including the library reference:
Dim dicD As Scripting.Dictionary
Set dicD = New Scripting.Dictionary
or
Dim dicD As Object
Set dicD = CreateObject("Scripting.Dictionary")
But I suspect your problem is mainly due to a missing reference.
 
Upvote 0
Should be fixed by re-adding the reference:
In the visual basic editor under TOOLS | REFERENCES.. check the box for Microsoft Scripting Runtime.

As mentioned, you can also late bind by declaring the objects with this syntax:
Dim dicD As Object
Set dicD = CreateObject("Scripting.Dictionary")


If you late bind, the reference is not needed at compile time and will be resolved at runtime. But you won't have intellisense while developing or writing code.
 
Upvote 0
Thank you both. I did switch computers and when I set up my references I forgot the scripting one out.

*FACEPALM*!!!!

lol

Rich
 
Upvote 0

Forum statistics

Threads
1,214,908
Messages
6,122,187
Members
449,071
Latest member
cdnMech

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