Thursday, June 4, 2020

Find duplicate value in column along with row number using vba

Hi Folks,

In sheet, particular column if we need to find the duplicate value for some text and on which row that text appears, we can find it using below logic. Also, here the column name can also be dynamic on sheet, so this will find it based on column index in given range.

Sub fnFindDupValRowNoInCol()
Dim shRead As Worksheet
Set shRead = ThisWorkbook.Sheets("WorksheetDemo")
strSearchNameTxt = "Priya"
'function to get the column index based on name
ColNameIndexrST = fnGetColIndex(shRead, "Name")
MsgBox "Name column index is " & ColNameIndexrST
'function to find row number for given search text

Dim iWriteSTNameRowNoFlag As String: iWriteSTNameRowNoFlag = GetshWriteNametextRow(shRead, strSearchNameTxt, ColNameIndexrST)
iWriteSTNameRowN0RecVal = Split(iWriteSTNameRowNoFlag, ";")
                If UBound(iWriteSTNameRowN0RecVal) > 1 Then
                    MsgBox "Mulitple value found"
                    MsgBox "Total number of duplicate value is " & UBound(iWriteSTNameRowN0RecVal)
                    flgmultiRec = True
                Else
                    MsgBox "multiple value not found"
                    flgmultiRec = False
                    iWriteSTNameRowNo = iWriteSTNameRowN0RecVal(1)
                End If
End Sub
Public Function fnGetColIndex(WST As Worksheet, strSearchCol)
        Set findrng = WST.Range("1:1")
        ColIndex = findrng.Find(strSearchCol, LookIn:=xlValues, LookAt:=xlWhole).Column
        fnGetColIndex = ColIndex
End Function

Public Function GetshWriteNametextRow(WST As Worksheet, strSearchTxt, strColIndex)
GetshWriteNametextRow = 0
WST.Activate
'code to find last used rows
shWritelRows = WST.Cells(Rows.Count, strColIndex).End(xlUp).Row
'code to give Range along with column index instead A1 kind of
'Range(A1) is same as Range(cells(1,1)
Set Rng1 = WST.Range(WST.Cells(1, strColIndex), WST.Cells(shWritelRows, strColIndex))
flgMoreMatchCnt = False
Dim matchIndexVal As String
rowval = 0
With ActiveSheet
    Set Rng = .UsedRange.Find(strSearchTxt)
    If Not Rng Is Nothing Then
        firstAddress = Rng.Address
        Do
            'c.Value = 5
            Row = Rng.Row
            MsgBox " Search value found at row " & Row
            rowval = rowval & ";" & Row
            Set Rng = .UsedRange.FindNext(Rng)
        If Rng Is Nothing Then
            GoTo DoneFinding
        End If
        Loop While Rng.Address <> firstAddress
      End If
DoneFinding:

End With
GetshWriteNametextRow = rowval
End Function

Cheers.
TJ

No comments:

Post a Comment