help with finding exect match's in two columns and clearing entire row

[2011gerry007]

I have a csv file that I need vba code to search through two specific columns row by row (I & J): and if an exact match found delete the entire row

So far I have long winded VBA that almost works, but unfortunately it only looks at one specific ie: column( J) at the moment, So what i need is for it to check two columns instead of one, so i need some help with tweaking by an expert and not an novice like myself

For instance

If Column (I2) = "john smith" & Column (J2) = "finance" ..then keep first instance of the entirerow and delete the rest of the rows below that that are contain the same value
but if the next row contains in Column (I3) = "mary smith" and Column(J3) = "finance"
and if a both column I2 = vbNullString & column I3vbNullString move on to next row

The below vba is what I have so far. any thoughts on a variation on this or even to get it run faster would be great ..many thanks in advance

Sub RemoveRepeatingStrings1()

    Dim BaseStr As String, CurrStr As String
    Dim EndRow As Long
    Dim Iter As Integer
    Dim next1 As Variant
      

    EndRow = Range("A" & Rows.Count).End(xlUp).Row
    BaseStr = Range("A1").Value

   Application.ScreenUpdating = False

    For Iter = 2 To EndRow
        CurrStr = Range("j" & Iter).Value
        If Range("J" & Iter).Value = vbNullString Then GoTo next1
      
      
        If CurrStr = BaseStr Then
            'Range("J" & Iter).Value = vbNullString
            MsgBox Iter & " " & CurrStr
            'Range("j" & Iter).EntireRow.Delete
            Range("j" & Iter).EntireRow.ClearContents
        'iter = iter - 1

next1:        Else
            BaseStr = Range("j" & Iter).Value
            MsgBox Iter & " " & BaseStr
        End If

    Next Iter

   Application.ScreenUpdating = True

Call DeleteBlankRows

End Sub


'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Sub DeleteBlankRows()
    Dim i As Long
    Dim DelRange As Range

    On Error GoTo Whoa

    Application.ScreenUpdating = False

    For i = 1 To 5000
        If Application.WorksheetFunction.CountA(Range("A" & i & ":" & "Z" & i)) = 0 Then
            If DelRange Is Nothing Then
                Set DelRange = Rows(i)
            Else
                Set DelRange = Union(DelRange, Rows(i))
            End If
        End If
    Next i

    If Not DelRange Is Nothing Then DelRange.Delete shift:=xlUp
LetsContinue:
    Application.ScreenUpdating = True

    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

Any help or thoughts on this would be a great help
__________________________________________________________________

Mod edit : thread moved to appropriate forum !​

 

[jindon]

This reads from csv file directly.

Sub test()
    Dim fn As String, e, temp, txt
    fn = Application.GetOpenFilename("CSVFile,*.csv")
    If fn = "" Then Exit Sub
    With CreateObject("Scripting.Dictionary")
        For Each e In Split(CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).ReadAll, vbCrLf)
            txt = CleanCSV(e, Chr(2), Chr(3))
            temp = Split(txt, ",")(7) & Chr(2) & Split(txt, ",")(8)
            If Not .exists(temp) Then .Item(temp) = e
        Next
        e = .items
    End With
    With Cells(1).Resize(UBound(e) + 1)
        .Value = Application.Transpose(e)
        .TextToColumns .Cells(1), comma:=True
        .Replace Chr(2), ",", 2
        .Replace Chr(3), "", 2
    End With
End Sub

Function CleanCSV(ByVal txt As String, ByVal subComma As String, _
                  ByVal subDQ As String) As String
    Dim m As Object
    Static RegX As Object
    If RegX Is Nothing Then Set RegX = CreateObject("VBScript.RegExp")
    With RegX
        .Pattern = "(^|,)(""[^""]+"")(,|$)"
        Do While .test(txt)
            Set m = .Execute(txt)(0)
            txt = Application.Replace(txt, m.firstindex + 1, _
            m.Length, m.submatches(0) & Replace(Replace(m.submatches(1), _
            ",", subComma), """", subDQ) & m.submatches(2))
        Loop
    End With
    CleanCSV = txt
End Function

 

[2011gerry007]

many thanks, just what i needed