Welcome to ShenZhenJia Knowledge Sharing Community for programmer and developer-Open, Learning and Share
menu search
person
Welcome To Ask or Share your Answers For Others

Categories

I'm having problem with the following line of code:

    Set DICT = RowMap(Range(Workbooks("A").Sheets(1).Cells(ITEM_NO_ROW, _
ITEM_NO_COLUMN), Workbooks("A").Sheets(1).Cells(ITEM_NO_ROW + 1, ITEM_NO_COLUMN).End(xlDown)))

This code calls RowMap. I put a break at "End Function" of RowMap and check the count of rv and RowMap in the Watch Window. Both counts are 84 as they should be. However, as soon as I hit F8 which takes me to the main routine, and check the count of DICT, it is 85, not 84.

Shouldn't DICT be exactly the same as RowMap or rv? Why is the count of DICT incremented by 1? Which line of code makes it do that? I am completely lost.

I don't know if this info would help or not. The above Set DICT line is wrapped in a "For each cell in rng" loop and it is the cell that is added to the end of the DICT.

Any help will be greatly appreciated.

Function RowMap(rng1 As Range) As Object
'store item no and price in dictionary

    Dim rv As Object
    Dim c As Range
    Dim v As long
    On Error Resume Next

    Set rv = Nothing

    Set rv = CreateObject("scripting.dictionary")
    For Each c In rng1.Cells
        v = c.Value
        If Not rv.Exists(v) Then
            rv.Add v, c.Offset(0, 4) 'add item no and price
        Else
            MsgBox "Duplicate value detected in " & Book_Name & "!"
            Exit For
        End If
        Next c

    Set RowMap = rv

End Function

    For Each wk In Application.Workbooks

    If Left(wk.Name, 6) = "All FE" Then

        ERROR_Sheet_No = ERROR_Sheet_No + 1

        For Each sh In wk.Sheets

            Set Report_Last_Cell = sh.Cells(5000, 3).End(xlUp)

            'sort the data by group code
            Set rng = sh.Range(sh.Cells(4, 1), Report_Last_Cell.Offset(0, 4))

            rng.Sort key1:=sh.Cells(4, 4), order1:=xlAscending, Header:=xlNo

            Set rng = sh.Range(sh.Cells(4, 3), Report_Last_Cell)

            For Each cell In rng
                If cell.Value <> "LAVENDER" And cell.Value <> "CLOSED" And cell.Value <> "VOID" And cell.Value <> "NO SALE" And _
                    InStr(cell.Value, "DISCOUNT") = 0 And InStr(cell.Value, "DEPOSIT") = 0 And Len(cell) <> 0 Then

                    Group_Code = cell.Offset(0, 1).Value

                    If Group_Code <> Old_Group_Code Then 'open the PHOTO_QUOTE file
                        'close the old PHOTO_QUOTE file first
                        On Error Resume Next
                        Workbooks(File_Prefix & Old_Group_Code & ".xlsx").Close
                        On Error GoTo 0

                        'open the PHOTO QUOTE file if exists
                        If Len(Dir(Flower_Path & File_Prefix & Group_Code & ".xlsx")) <> 0 Then 'if file is found
                            Workbooks.Open Flower_Path & File_Prefix & Group_Code & ".xlsx"

                            Photo_Quote_Book_Name = File_Prefix & Group_Code & ".xlsx"
                            On Error Resume Next
                            DICT.RemoveAll
                            Set DICT = Nothing

                            Set DICT = RowMap(Range(Workbooks(Photo_Quote_Book_Name).Sheets(1).Cells(PHOTO_QUOTE_ITEM_NO_ROW, _
                                PHOTO_QUOTE_ITEM_NO_COLUMN), Workbooks(Photo_Quote_Book_Name).Sheets(1).Cells(PHOTO_QUOTE_ITEM_NO_ROW + 1, PHOTO_QUOTE_ITEM_NO_COLUMN).End(xlDown)))
                            On Error GoTo 0

                            'check if ITEM NO exists
                            If Not DICT.Exists(cell.Value) Then
                                Copy_to_ERROR_sheet sh.Name, ERROR_Sheet_lastrow, 0, 0, 255


                            'check if price matches
                            ElseIf cell.Offset(0, 3).Value <> DICT(cell.Value) Then
                                Copy_to_ERROR_sheet sh.Name, ERROR_Sheet_lastrow, 0, 255, 0
                            End If


                        Else 'if the PHOTO_QUOTE file doesn't exist, copy shop, date, voucher no, item no, price to
                        ' ERROR_BOOK_NAME and change color to red

                            Copy_to_ERROR_sheet sh.Name, ERROR_Sheet_lastrow, 255, 0, 0
                        End If 'If Len(Dir(Flower_Path & File_Prefix & Group_Code & ".xlsx")) <> 0 Then

                        Old_Group_Code = Group_Code
                    End If ' If Group_Code <> Old_Group_Code Then


                End If 'If cell.Value <> "LAVENDER" And cell.Value <> "CLOSED" And cell.Value <> "VOID" And cell.Value <> "NO SALE" And _
                InStr(cell.Value, "DISCOUNT") = 0 And InStr(cell.Value, "DEPOSIT") = 0 And Len(cell) <> 0 Then

            Next 'For Each cell In rng


        Next 'For Each sh In wk

    End If 'If Left(wk.Name, 6) = "All FE" Then

Next 'For Each wk In Application.Workbooks

Close_PHOTO

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub 'Check_Price
See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
thumb_up_alt 0 like thumb_down_alt 0 dislike
122 views
Welcome To Ask or Share your Answers For Others

1 Answer

Here's an example of what can happen if you're not careful using the Watch window when working with a Dictionary.

Enter this code in a module and set a break and two watches as indicated :

Sub Tester()

    Dim dict As Object
    Set dict = CreateObject("scripting.dictionary")

    dict.Add "A", 1
    dict.Add "B", 2
    dict.Add "C", 3  '<<< put a break here
    dict.Add "D", 4

    Debug.Print dict("D")    '<< put a watch on `dict("D")`
    Debug.Print dict.Count   '<< put a watch on `dict`

End Sub

Now run to the break and check the Watch window - even though your code is still waiting on the break (and the "C" key is not added yet), your dictionary already has an empty "D" slot (and count is 3, not 2).

enter image description here

Even if you delete the dict.Add "D", 4 from your code, the watch on dict("D") will remain in the Watch window (unless you actively delete it) and will keep adding that "extra" key...


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
thumb_up_alt 0 like thumb_down_alt 0 dislike
Welcome to ShenZhenJia Knowledge Sharing Community for programmer and developer-Open, Learning and Share
...