Excel VBA Find Duplicates and post to different sheet
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!
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
hold.Exists along with an
ElseIf to remove the
GoTo's. Also changed it to copy and paste the row to the next sheet.
作者: Garrett Rincon 的来源 发布者： 2018 年 10 月 18 日
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
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
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:
作者: AJD 发布者: 2018 年 10 月 27 日
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