Find duplicates when pulling data from other sheets

[crazyeyeschase]

I have an excel sheet to manage parking for three different companies. Each company has their own document and my document then imports their sheet info a master document that I manage.

I then have a master sheet that imports all the info.

The problem I am having is that if two companies assign the same spot or if I fat finger something i cannot see that uness i search the spot number within all sheets.

The following code is what's used to pull the data from the other sheets into the maser sheet.

Is there a way to either search for duplicates in column F on the three different sheets and return a message that spot "X" has a duplicate"

Something that can be ran before the below macro or even during the same operation.

Sub UpdateAll()
  Dim sh4 As Worksheet
  Dim dic As Object
  Dim a As Variant, d As Variant, arrSh As Variant, aSh As Variant
  Dim i As Long, nRow As Long
  
  Set dic = CreateObject("Scripting.Dictionary")
  Set sh4 = Sheets("All Parking")
  arrSh = Array("Company 1", "Company 2", "Company 3")
  
  On Error Resume Next
    Sheet4.ShowAllData
  On Error GoTo 0
  
  d = sh4.Range("A1", sh4.Range("G" & Rows.Count).End(3)).Value2
  For i = 1 To UBound(d)
    dic(d(i, 7)) = i                'index for column G
  Next
    
  For Each aSh In arrSh
    a = Sheets(aSh).Range("A2", Sheets(aSh).Range("F" & Rows.Count).End(3)).Value2
    For i = 1 To UBound(a)
      If dic.exists(a(i, 6)) Then   'compare column F with column G
        nRow = dic(a(i, 6))
        d(nRow, 1) = a(i, 1)        'copy A to A
        d(nRow, 2) = a(i, 2)        'copy B to B
        d(nRow, 3) = aSh            'sheet name
        d(nRow, 4) = a(i, 3)        'copy C to D
        d(nRow, 6) = a(i, 4)        'copy D to F
      End If
    Next i
  Next aSh
  
  sh4.Range("A1").Resize(UBound(d, 1), UBound(d, 2)).Value = d
End Sub

 

[Trebor76]

Hi there,

Try this:

Option Explicit
Sub UpdateAll()

    Dim sh4 As Worksheet
    Dim dic As Object
    Dim a As Variant, d As Variant, arrSh As Variant, aSh As Variant, varItem As Variant
    Dim i As Long, nRow As Long
    Dim clnDupsCheck As New Collection
    Dim strDupsMsg As String
    
    Set dic = CreateObject("Scripting.Dictionary")
    Set sh4 = Sheets("All Parking")
    arrSh = Array("Company 1", "Company 2", "Company 3")
    
    For Each aSh In arrSh
        a = Sheets(aSh).Range("F2", Sheets(aSh).Range("F" & Rows.Count).End(3)).Value2
        For Each varItem In a
            On Error Resume Next
                clnDupsCheck.Add CStr(varItem), varItem
                If Err.Number <> 0 Then
                    strDupsMsg = IIf(Len(strDupsMsg) = 0, varItem, strDupsMsg & vbNewLine & varItem)
                End If
            On Error GoTo 0
        Next varItem
    Next aSh
    
    If Len(strDupsMsg) > 0 Then
        MsgBox "The following spots have been duplicated:" & vbNewLine & strDupsMsg, vbExclamation
        Exit Sub
    End If
    
    On Error Resume Next
        Sheet4.ShowAllData
    On Error GoTo 0
    
    d = sh4.Range("A1", sh4.Range("G" & Rows.Count).End(3)).Value2
    For i = 1 To UBound(d)
     dic(d(i, 7)) = i                'index for column G
    Next i
    
    For Each aSh In arrSh
        a = Sheets(aSh).Range("A2", Sheets(aSh).Range("F" & Rows.Count).End(3)).Value2
        For i = 1 To UBound(a)
            If dic.exists(a(i, 6)) Then   'compare column F with column G
                nRow = dic(a(i, 6))
                d(nRow, 1) = a(i, 1)        'copy A to A
                d(nRow, 2) = a(i, 2)        'copy B to B
                d(nRow, 3) = aSh            'sheet name
                d(nRow, 4) = a(i, 3)        'copy C to D
                d(nRow, 6) = a(i, 4)        'copy D to F
            End If
        Next i
    Next aSh
    
    sh4.Range("A1").Resize(UBound(d, 1), UBound(d, 2)).Value = d
  
End Sub

Regards,

Robert

 

[crazyeyeschase]

Robert,

Thanks for that. When in testing this seems like it would work but I it seems to be finding all duplicates. Maye I worded my original post wrong.

Below is the "All Parking" sheet

this what each company sheet looks like

When I run your macro it displays every single spot that's assigned.

I guess I need macro that can review column F in sheets "company 1, company 2, and company 3" sheets" and find any match within those columns.

ill keep doing some research.

 

[Trebor76]

I guess I need macro that can review column F in sheets "company 1, company 2, and company 3" sheets" and find any match within those columns.

That's what I was trying to do. I think we just need to account for blanks as I see Col. F has no entries or else these will be included in the array so maybe:

Option Explicit
Sub UpdateAll()

    Dim sh4 As Worksheet
    Dim dic As Object
    Dim a As Variant, d As Variant, arrSh As Variant, aSh As Variant, varItem As Variant
    Dim i As Long, nRow As Long
    Dim clnDupsCheck As New Collection
    Dim strDupsMsg As String
    
    Set dic = CreateObject("Scripting.Dictionary")
    Set sh4 = Sheets("All Parking")
    arrSh = Array("Company 1", "Company 2", "Company 3")
    
    For Each aSh In arrSh
        a = Sheets(aSh).Range("F2", Sheets(aSh).Range("F" & Rows.Count).End(3)).Value2
        For Each varItem In a
            If Len(varItem) > 0 Then
                On Error Resume Next
                    clnDupsCheck.Add CStr(varItem), varItem
                    If Err.Number <> 0 Then
                        strDupsMsg = IIf(Len(strDupsMsg) = 0, varItem, strDupsMsg & vbNewLine & varItem)
                    End If
                On Error GoTo 0
            End If
        Next varItem
    Next aSh
    
    If Len(strDupsMsg) > 0 Then
        MsgBox "The following spots have been duplicated:" & vbNewLine & strDupsMsg, vbExclamation
        Exit Sub
    End If
    
    On Error Resume Next
        Sheet4.ShowAllData
    On Error GoTo 0
    
    d = sh4.Range("A1", sh4.Range("G" & Rows.Count).End(3)).Value2
    For i = 1 To UBound(d)
        dic(d(i, 7)) = i                'index for column G
    Next i
    
    For Each aSh In arrSh
        a = Sheets(aSh).Range("A2", Sheets(aSh).Range("F" & Rows.Count).End(3)).Value2
        For i = 1 To UBound(a)
            If dic.exists(a(i, 6)) Then   'compare column F with column G
                nRow = dic(a(i, 6))
                d(nRow, 1) = a(i, 1)        'copy A to A
                d(nRow, 2) = a(i, 2)        'copy B to B
                d(nRow, 3) = aSh            'sheet name
                d(nRow, 4) = a(i, 3)        'copy C to D
                d(nRow, 6) = a(i, 4)        'copy D to F
            End If
        Next i
    Next aSh
    
    sh4.Range("A1").Resize(UBound(d, 1), UBound(d, 2)).Value = d
  
End Sub

Regards,

Robert