• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 528
  • Last Modified:

Check whether a value exists in column using Excel VBA

I am iterating through a column of data getting the value of each cell, what I need to do is check whether the cell value exists within another column. If it does I would like to focus on the row and offer the option 'Yes/No' to delete the cell.
0
Blowfelt82
Asked:
Blowfelt82
1 Solution
 
Blowfelt82Author Commented:
One thing to mention is that the value I am comparing is a filename without extension, and the column I am checking for the value in has a known extension.
0
 
krishnakrkcCommented:
Hi

Try

adjust the settings.

Sub kTest()
    
    Dim k, ka, i As Long, txt As String, n As String
    Dim a() As String, j As Long
    '// Adjust to suit
    Const SearchCol     As Long = 2
    Const FileNameCol   As Long = 10
    Const StartRow      As Long = 2
    Const ShtName       As String = "Sheet1"
    '// End
    k = Intersect(Worksheets(ShtName).UsedRange, Worksheets(ShtName).Columns(SearchCol)).Value2
    ka = Intersect(Worksheets(ShtName).UsedRange, Worksheets(ShtName).Columns(FileNameCol)).Value2
    
    With CreateObject("scripting.dictionary")
        .comparemode = 1
        For i = 1 To UBound(ka, 1)
            If Len(ka(i, 1)) Then _
            n = Left$(ka(i, 1), InStrRev(ka(i, 1), ".") - 1)
            .Item(n) = Empty
        Next
        For i = 1 To UBound(k, 1)
            If .exists(k(i, 1)) Then
                txt = IIf(Len(txt), txt & ",a" & StartRow + i - 1, "A" & StartRow + i - 1)
                If Len(txt) > 245 Then
                    j = j + 1: ReDim Preserve a(1 To j)
                    a(j) = txt: txt = vbNullString
                End If
            End If
        Next
        If Len(txt) Then
            j = j + 1: ReDim Preserve a(1 To j)
            a(j) = txt: txt = vbNullString
        End If
        If j Then
            If MsgBox("Do you want to delete the matched cells?", vbYesNo) = 6 Then
                For i = j To 1 Step -1
'                    Range(a(j)).EntireRow.Delete    'delete rows
                    Worksheets(ShtName).Columns(SearchCol).Range(a(j)).Delete -4162        'delete cells
                Next
            End If
        End If
    End With
    
End Sub

Open in new window


Kris
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Tackle projects and never again get stuck behind a technical roadblock.
Join Now