search for duplicate range value

r121a947

New member
Joined
Jun 29, 2019
Messages
49
Reaction score
0
Points
0
Excel Version(s)
Office 365
Is there a way to search for a range value, the same as is possible for a cell value?

This would be like the first step of the Remove Duplicates function, but stopping before the delete.

Is there a way to see the code underlying the Remove Duplicates function? I could probably copy and use that for this step.

Thank you.
 
Here is one I have been using for years

Code:
Sub DeleteDuplicateRows()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DeleteDuplicateRows
' This will delete duplicate records, based on the Active Column. That is,
' if the same value is found more than once in the Active Column, all but
' the first (lowest row number) will be deleted.
'
' To run the macro, select the entire column you wish to scan for
' duplicates, and run this procedure.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


    Dim r As Long
    Dim n As Long
    Dim v As Variant
    Dim rng As Range


    On Error GoTo EndMacro
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual




    Set rng = Application.Intersect(ActiveSheet.UsedRange, _
                                    ActiveSheet.Columns(ActiveCell.Column))


    Application.StatusBar = "Processing Row: " & Format(rng.Row, "#,##0")


    n = 0
    For r = rng.Rows.Count To 2 Step -1
        If r Mod 500 = 0 Then
            Application.StatusBar = "Processing Row: " & Format(r, "#,##0")
        End If


        v = rng.Cells(r, 1).Value
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ' Note that COUNTIF works oddly with a Variant that is equal to vbNullString.
        ' Rather than pass in the variant, you need to pass in vbNullString explicitly.
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        If v = vbNullString Then
            If Application.WorksheetFunction.CountIf(rng.Columns(1), vbNullString) > 1 Then
                rng.Rows(r).EntireRow.Delete
                'rng.Rows(r).EntireRow.Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row + 1
                n = n + 1
            End If
        Else
            If Application.WorksheetFunction.CountIf(rng.Columns(1), v) > 1 Then
                rng.Rows(r).EntireRow.Delete
                'rng.Rows(r).EntireRow.Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row + 1
                n = n + 1
            End If
        End If
    Next r


EndMacro:


    Application.StatusBar = False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "Duplicate Rows Deleted: " & CStr(n)




End Sub
 
Thank you.

I am looking for a procedure that will do the search for the values from several columns at once. I need to match columns B to E, from a child file, to find a unique record in my parent file catalog.
 
I have a music catalog (> 42K unique records). A unique record is defined by columns B thru E. From these records I have created scores of playlists, which are stored in individual workbooks. (I am in the process of transferring the playlist files to a single workbook, each playlist as a named worksheet.)


Many of the songs have been used in multiple playlists, and I am trying to create a routine to update the catalog file to show in which playlists a particular song has been used. The total number of playlist song is > 10K, so it has to be automated.


I am very new to Excel and VBA, so what I have pieced together is mostly “monkey see, monkey do” for each step. I am certain there are far better and easier ways to do these things . . . I just don't know how.


The enclosed version works fine for the first loop, but then breaks down on where the update information is placed. I have tried various iterations, but have not found the solution.


Any and all help will be greatly appreciated. I have attached sample files,along with the pasted code. Thank you for your interest and assistance.



p.s. If anyone wants to see the playlists, they are on Spotify under my user ID: r121a947.

Code:
Sub UpdateFiles()

' Looking to match criteria of four culumns, which defines a unique record, and then update that record

' Tape file variables
Dim updFN As Variant ' If this is the worksheet name, is there a way to get it from the file?
Dim numRows As Long ' Is there a way to grab this from the file?
Dim Bmatch As Variant
Dim Cmatch As Variant
Dim Dmatch As Variant
Dim Ematch As Variant
Dim curRow As Long
Dim tapFile As Variant

' Catalog file variables
Dim fndRow As Long ' I am unable to find a way to retrieve this value; the row number of a found match
Dim matchRow As Long ' I am unable to find a way to retrieve this value; the row number that matches all criteria
Dim Bfind As Variant
Dim Cfind As Variant
Dim Dfind As Variant
Dim Efind As Variant
Dim catFile As Variant

' Open catalog file and switch back to tape file
catFile = Application.GetOpenFilename
Workbooks.Open Filename:=catFile
ActiveWindow.ActivatePrevious

' Get updFN
updFN = Application.InputBox(prompt:="What is the filename to use to update?", Title:="Update Filename")
'    MsgBox ("The name of the file to use to update is ") & updFN
    
' Get numRows
numRows = Application.InputBox(prompt:="How many rows are in " & updFN & "?", Title:="Update File Rows")
'    MsgBox ("There are " & numRows & " rows in " & updFN)

Application.ScreenUpdating = False

' Get Bmatch . . . Ematch
 For curRow = 1 To numRows
    Bmatch = Cells(curRow, 2).Value
    Cmatch = Cells(curRow, 3).Value
    Dmatch = Cells(curRow, 4).Value
    Ematch = Cells(curRow, 5).Value
    
   '  MsgBox (Bmatch)

' Switch back to catalog
ActiveWindow.ActivatePrevious

' Go to top of B and Search for Bmatch
Cells(2, 1).Activate
Columns("B:B").Select
    Selection.Find(What:=Bmatch, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=True, SearchFormat:=False).Activate
        
        ' This is where I would use fndRow; Cfind = Cells(fndRow, 3).Value
        ActiveCell.Offset(0, 1).Range("A1").Select
        Cfind = ActiveCell.Value
        ' MsgBox (Cmatch)
        ActiveCell.Offset(0, 1).Range("A1").Select
        Dfind = ActiveCell.Value
        ' MsgBox (Dmatch)
        ActiveCell.Offset(0, 1).Range("A1").Select
        Efind = ActiveCell.Value
        ' MsgBox (Ematch)
        
' Test for matches
If Cmatch <> Cfind Then Cells.FindNext(After:=ActiveCell).Activate ' It seems to hang up unless this command is repeated

Cells.FindNext(After:=ActiveCell).Activate

If Dmatch <> Dfind Then Cells.FindNext(After:=ActiveCell).Activate ' It seems to hang up unless this command is repeated

Cells.FindNext(After:=ActiveCell).Activate

If Ematch <> Efind Then Cells.FindNext(After:=ActiveCell).Activate

If Cmatch = Cfind And Dmatch = Dfind And Ematch = Efind Then ActiveCell.Offset(0, 10).Range("A1").Select ' This is where I would use matchRow;
                                                                                                        ' Cells(matchRow, 12).Value = Cells(matchRow, 12).Value & " " & updFN
ActiveCell.Offset(0, 10).Range("A1").Select ' For first loop, this must be repeated, but it ruins later loops

' Add update value to L cell
ActiveCell.Value = ActiveCell.Value & " " & updFN
    
' Switch back to tape file
ActiveWindow.ActivatePrevious

  Next curRow
    
Application.ScreenUpdating = True


End Sub
 

Attachments

  • cat.xlsm
    14.8 KB · Views: 5
  • tape.xlsm
    143.4 KB · Views: 7
I have a version that almost works.

It finds and updates some of the records, but not all. I do not get consistent results when running the routine with the two same files, multiple times.

What can cause such inconsistency? Is my Excel install buggy? Should I reinstall Excel?

Thanks for your interest and your help.
 
My mistake.

I misunderstood cross-posting to involve different forums on the same site.

I understand, now.

Please excuse me.
 
A user from the Chandoo forum provided a good solution.

Thank you for your interest and your assistance.
 
Back
Top