Slightly Modify VBA Code that deletes Dups

gheyman

Well-known Member
Joined
Nov 14, 2005
Messages
2,332
Office Version
  1. 365
Platform
  1. Windows
i need to modify this code because the data has changed with respect to column location.
previously the pertinent data was in B & C

It is now in C & E

I think changing it is straight forward except for this part
"lngLastRow = Range("B:C")"

Any help is appreciated!

Code:
Sub Delete_Duplicates()
'Author: G Heyman 190217
'Delete all duplicate rows so part number is only listed once for each Top level Assy

    Dim objMyUniqueData As Object
    Dim strMyKey As String
    Dim rngDelRange As Range
    Dim lngLastRow As Long
    Dim lngMyRow As Long
    
    Application.ScreenUpdating = False

    lngLastRow = Range("B:C").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Set objMyUniqueData = CreateObject("Scripting.Dictionary")

    For lngMyRow = 1 To lngLastRow
        If Len(Range("B" & lngMyRow)) > 0 And Len(Range("C" & lngMyRow)) > 0 Then
            strMyKey = Range("B" & lngMyRow) & Range("C" & lngMyRow)
            If objMyUniqueData.Exists(CStr(strMyKey)) = False Then
                objMyUniqueData.Add strMyKey, CStr(strMyKey)
            Else
                If rngDelRange Is Nothing Then
                    Set rngDelRange = Rows(lngMyRow)
                Else
                    Set rngDelRange = Union(rngDelRange, Rows(lngMyRow))
                End If
            End If
        End If
    Next lngMyRow
    
    Set objMyUniqueData = Nothing
    
'    If Not rngDelRange Is Nothing Then
'        rngDelRange.EntireRow.Delete
 '       MsgBox "Rows with Duplicate Part ID and End Part ID have now been deleted.", vbInformation
 '   Else
 '       MsgBox "There were no duplicated records found for Part ID and End Part ID. Nothing was deleted.", vbExclamation
 '   End If
    
    Application.ScreenUpdating = True
    
End Sub
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Try this

Code:
Sub Delete_Duplicates()
  Dim objMyUniqueData As Object, strMyKey As String, rngDelRange As Range
  Dim lngLastRow As Long, lngMyRow As Long
  Application.ScreenUpdating = False
  lngLastRow = Range("[COLOR=#0000ff]C:E[/COLOR]").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  Set rngDelRange = Rows(lngLastRow + 1)
  Set objMyUniqueData = CreateObject("Scripting.Dictionary")
  For lngMyRow = 1 To lngLastRow
    If Len(Range("[COLOR=#0000ff]C[/COLOR]" & lngMyRow)) > 0 And Len(Range("[COLOR=#0000ff]E[/COLOR]" & lngMyRow)) > 0 Then
      strMyKey = Range("[COLOR=#0000ff]C[/COLOR]" & lngMyRow) & Range("[COLOR=#0000ff]E[/COLOR]" & lngMyRow)
      If objMyUniqueData.Exists(CStr(strMyKey)) = False Then
        objMyUniqueData.Add strMyKey, CStr(strMyKey)
      Else
        Set rngDelRange = Union(rngDelRange, Rows(lngMyRow))
      End If
    End If
  Next lngMyRow
  Set objMyUniqueData = Nothing
  rngDelRange.EntireRow.Delete
  MsgBox "End"
  Application.ScreenUpdating = True
End Sub
 
Upvote 0
Solution

Forum statistics

Threads
1,213,543
Messages
6,114,240
Members
448,555
Latest member
RobertJones1986

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