Excel VBA查找重复项并发布到其他工作表

Question

I keep having an issue with some code in VBA Excel was looking for some help!

I am trying to sort through a list of names with corresponding phone numbers, checking for multiple names under the same phone number. Then post those names to a separate sheet.

So far my code is:

Sub main()
    Dim cName As New Collection
    For Each celli In Columns(3).Cells
    Sheets(2).Activate
        On Error GoTo raa
            If Not celli.Value = Empty Then
            cName.Add Item:=celli.Row, Key:="" & celli.Value
            End If
    Next celli
        On Error Resume Next
raa:
    Sheets(3).Activate
    Range("a1").Offset(celli.Row - 1, 0).Value = Range("a1").Offset(cName(celli.Value) - 1, 0).Value
    Resume Next
End Sub

When I try to run the code it crashes Excel, and does not give any error codes.

Some things I've tried to fix the issue:

• Shorted List of Items

• Converted phone numbers to string using cstr()

• Adjusted Range and offsets

I'm pretty new to all this, I only managed to get this far on the code with help from other posts on this site. Not sure where to go with this since it just crashes and gives me no error to look into. Any ideas are appreciated Thank you!

Updated:

Option Explicit
Dim output As Worksheet
Dim data As Worksheet
Dim hold As Object
Dim celli
Dim nextRow

Sub main()
    Set output = Worksheets("phoneFlags")
    Set data = Worksheets("filteredData")

    Set hold = CreateObject("Scripting.Dictionary")
        For Each celli In data.Columns(3).Cells
            On Error GoTo raa
            If Not IsEmpty(celli.Value) Then
                hold.Add Item:=celli.Row, Key:="" & celli.Value
            End If
        Next celli
        On Error Resume Next
raa:
    nextRow = output.Range("A" & Rows.Count).End(xlUp).Row + 1
    output.Range("A" & nextRow).Value = data.Range("A1").Offset(hold(celli.Value) - 1, 0).Value
    'data.Range("B1").Offset(celli.Row - 1, 0).Value = Range("B1").Offset(hold
    Resume Next
End Sub

Update2:

Used hold.Exists along with an ElseIf to remove the GoTo 's. Also changed it to copy and paste the row to the next sheet.

Sub main()
    Set output = Worksheets("phoneFlags")
    Set data = Worksheets("filteredData")
    Set hold = CreateObject("Scripting.Dictionary")

    For Each celli In data.Columns(2).Cells
        If Not hold.Exists(CStr(celli.Value)) Then
            If Not IsEmpty(celli.Value) Then
                hold.Add Item:=celli.Row, Key:="" & celli.Value
            Else
            End If
        ElseIf hold.Exists(CStr(celli.Value)) Then
            data.Rows(celli.Row).Copy (Sheets("phoneFlags").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0))
            'output.Range("A" & nextRow).Value = data.Range("A1").Offset(hold(celli.Value) - 1, 0).Value
        End If
    Next celli
End Sub

Answer 1

When developing code, don't try (or be afraid of) errors as they are pointers to help fix the code or the logic. As such, don't use On Error unless it is absolutely indicated in the coding algorithm (*). using On Error when not necessary only hides errors, does not fix them and when coding it is always better to avoid the errors in the first place (good logic).

When adding to the Dictionary, first check to see if the item already exists. The Microsoft documentation notes that trying to add an element that already exists causes an error. An advantage that the Dictionary object has over an ordinary Collection object in VBA is the .exists(value) method, which returns a Boolean .

The short answer to your question, now that I have the context out of the way, is that you can first check ( if Not hold.exists(CStr(celli.Value)) Then ) and then add if it does not already exist.

(*) As a side note, I was solving an Excel macro issue yesterday which took me most of the day to nut out, but the raising of errors and the use of debugging code helped me make some stable code rather than some buggy but kind-of-working code (which is what I was fixing in the first place). However, the use of error handling can be a short cut in some instances such as:

Function RangeExists(WS as Worksheet, NamedRange as String) As Boolean
Dim tResult as Boolean
Dim tRange as Range
    tResult = False ' The default for declaring a Boolean is False, but I like to be explicit
    On Error Goto SetResult ' the use of error means not using a loop through all the named ranges in the WS and can be quicker.
        Set tRange = WS.Range(NamedRange) ' will error out if the named range does not exist
        tResult = True
    On Error Goto 0 ' Always good to explicitly limit where error hiding occurs, but not necessary in this example
SetResult:
    RangeExists = tResult
End Function