Delete matching data

[ghrek]

Hi

Im posting on behalf of a friend. He's posted here but no replies.

Trying to delete matching data on 2 sheets

I have a workbook which has 2 sheets and sets of data. One sheet is called WFD and other is called TAB. What im trying to do is to get it to look at data in columns A-D in row 1 in sheet called TAB and then compare against ALL rows in the sheet called WFD. When I want it to compare...

www.excelforum.com

Here is the full question.

I have a workbook which has 2 sheets and sets of data.

One sheet is called WFD and other is called TAB.

What im trying to do is to get it to look at data in columns A-D in row 1 in sheet called TAB and then compare against ALL rows in the sheet called WFD. When I want it to compare against all rows, I need it to be an EXACT match across all the 4 columns.

If there is a match, then I need that row deleting from the sheet called TAB and WFD.

I then need it to keep repeating moving down the rows one by one until it gets to the last row of sheet called TAB. This then will leave only the rows where is data in sheet called TAB but NOT in sheet called WFD and VV.

There may be occasions in sheet called WFD data is duplicated. If this is the case and there is only 1 entry in sheet called TAB then I only need 1 entry from sheet called WFD deleting. .

Any Ideas?

 

[Leo Skywalker]

Hi

Im posting on behalf of a friend. He's posted here but no replies.

Trying to delete matching data on 2 sheets

I have a workbook which has 2 sheets and sets of data. One sheet is called WFD and other is called TAB. What im trying to do is to get it to look at data in columns A-D in row 1 in sheet called TAB and then compare against ALL rows in the sheet called WFD. When I want it to compare...

www.excelforum.com

Here is the full question.

I have a workbook which has 2 sheets and sets of data.

One sheet is called WFD and other is called TAB.

What im trying to do is to get it to look at data in columns A-D in row 1 in sheet called TAB and then compare against ALL rows in the sheet called WFD. When I want it to compare against all rows, I need it to be an EXACT match across all the 4 columns.

If there is a match, then I need that row deleting from the sheet called TAB and WFD.

I then need it to keep repeating moving down the rows one by one until it gets to the last row of sheet called TAB. This then will leave only the rows where is data in sheet called TAB but NOT in sheet called WFD and VV.

There may be occasions in sheet called WFD data is duplicated. If this is the case and there is only 1 entry in sheet called TAB then I only need 1 entry from sheet called WFD deleting. .

Any Ideas?

Hi there,

The request is not clear to me.
Do you want to delete all the matching rows found in WFD?, or leave one?
Do you want to delete all the matching rows in TAB? or leave one?

 

[ghrek]

Hi there,

The request is not clear to me.
Do you want to delete all the matching rows found in WFD?, or leave one?
Do you want to delete all the matching rows in TAB? or leave one?

just asked,

If there one entry on sheet called TAB and only one on sheet called WFD then both deleting , but if only one on TAB and TWO on WFD then only delete TAB and one entry on WFD leaving one there. .

The same applies the other way round with 2 entries in sheet called TAB

 

[johnnyL]

Here is what I came up with:

Temp.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L
1	NLC	M/C NO	DATE	VALUE
2	4048	6416	1/30/2020	£606.35			4048	6416	2/1/2020	£6.00	MISSING
3	4048	6416	1/30/2020	£20.90			4048	6416	1/6/2022	£639.85	MISSING
4	4048	6416	1/31/2020	£639.85
5	4048	6416	2/1/2020	£6.00
6	4048	6416	1/6/2022	£639.85
7	1409	2652	1/25/2022	£580.00
8
TAB

Temp.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L
1	NLC	M/C NO	DATE	VALUE
2	1409	2652	1/25/2022	£580.00			4048	6416	1/30/2020	£20.90	DUPLICATE
3	4048	6416	1/30/2020	£606.35			5698	9854	2/1/2022	£2,000.00
4	4048	6416	1/30/2020	£20.90			1409	2652	1/25/2022	£580.00	DUPLICATE
5	4048	6416	1/31/2020	£639.85
6	4048	6416	1/30/2020	£20.90
7	5698	9854	2/1/2022	£2,000.00
8	1409	2652	1/25/2022	£580.00
9
WFD

Here is the code I used, I left it long to make it easier to follow. There are several loops, but they are loops in memory so they are very quick.

Sub TAB_WFD()
'
    Dim DuplicateFound      As Boolean
    Dim TempValue           As Currency
    Dim TempDATE            As Date
    Dim ArrayColumn         As Long, ArrayRow               As Long, CheckForDuplicateRow   As Long, FinalArrayRow  As Long
    Dim TAB_Count           As Long, WFD_Count              As Long
    Dim TempMC_NO           As Long, TempNLC                As Long
    Dim OriginalTAB_Array   As Variant, OriginalWFD_Array   As Variant
'
    OriginalTAB_Array = Sheets("TAB").Range("A2:E" & Sheets("TAB").Range("A" & Rows.Count).End(xlUp).Row)           ' Save data from 'TAB' sheet into OriginalTAB_Array
    OriginalWFD_Array = Sheets("WFD").Range("A2:E" & Sheets("WFD").Range("A" & Rows.Count).End(xlUp).Row)           ' Save data from 'WFD' sheet into OriginalWFD_Array
'
' Find any duplicates in OriginalTAB_Array
    For CheckForDuplicateRow = 1 To UBound(OriginalTAB_Array, 1) - 1                                                ' Loop through all rows of OriginalTAB_Array - 1
          TempNLC = OriginalTAB_Array(CheckForDuplicateRow, 1)                                                      '   Save value from first column of OriginalTAB_Array into TempNLC
        TempMC_NO = OriginalTAB_Array(CheckForDuplicateRow, 2)                                                      '   Save value from second column of OriginalTAB_Array into TempMC_NO
         TempDATE = OriginalTAB_Array(CheckForDuplicateRow, 3)                                                      '   Save value from third column of OriginalTAB_Array into TempDATE
        TempValue = OriginalTAB_Array(CheckForDuplicateRow, 4)                                                      '   Save value from fourth column of OriginalTAB_Array into TempValue
'
        For ArrayRow = CheckForDuplicateRow + 1 To UBound(OriginalTAB_Array, 1)                                     '   Loop through lower rows of OriginalTAB_Array
            If OriginalTAB_Array(ArrayRow, 5) = vbNullString Then                                                   '       If last column in OriginalTAB_Array is blank then ...
                If OriginalTAB_Array(ArrayRow, 1) = TempNLC Then                                                    '           If first column = TempNLC then ...
                    If OriginalTAB_Array(ArrayRow, 2) = TempMC_NO Then                                              '               If second column = TempMC_NO then ...
                        If OriginalTAB_Array(ArrayRow, 3) = TempDATE Then                                           '                   If third column = TempDATE then ...
                            If OriginalTAB_Array(ArrayRow, 4) = TempValue Then                                      '                       If fourth column = TempValue then
                                OriginalTAB_Array(CheckForDuplicateRow, 5) = "DUPLICATE"                            '                           We have found a match, set 5th column to 'DUPLICATE'
                                OriginalTAB_Array(ArrayRow, 5) = "DUPLICATE"                                        '                           We have found a match, set 5th column to 'DUPLICATE'
                            End If
                        End If
                    End If
                End If
            End If
        Next                                                                                                        '   Loop back
    Next                                                                                                            ' Loop back
'
'-------------------------------------------------------------------------------------------------------------------
'
' Find any duplicates in OriginalWFD_Array
    For CheckForDuplicateRow = 1 To UBound(OriginalWFD_Array, 1) - 1                                                ' Loop through all rows of OriginalWFD_Array - 1
          TempNLC = OriginalWFD_Array(CheckForDuplicateRow, 1)                                                      '   Save value from first column of OriginalWFD_Array into TempNLC
        TempMC_NO = OriginalWFD_Array(CheckForDuplicateRow, 2)                                                      '   Save value from second column of OriginalWFD_Array into TempMC_NO
         TempDATE = OriginalWFD_Array(CheckForDuplicateRow, 3)                                                      '   Save value from third column of OriginalWFD_Array into TempDATE
        TempValue = OriginalWFD_Array(CheckForDuplicateRow, 4)                                                      '   Save value from fourth column of OriginalWFD_Array into TempValue
'
        For ArrayRow = CheckForDuplicateRow + 1 To UBound(OriginalWFD_Array, 1)                                     '   Loop through lower rows of OriginalWFD_Array
            If OriginalWFD_Array(ArrayRow, 5) = vbNullString Then                                                   '       If last column in OriginalWFD_Array is blank then ...
                If OriginalWFD_Array(ArrayRow, 1) = TempNLC Then                                                    '           If first column = TempNLC then ...
                    If OriginalWFD_Array(ArrayRow, 2) = TempMC_NO Then                                              '               If second column = TempMC_NO then ...
                        If OriginalWFD_Array(ArrayRow, 3) = TempDATE Then                                           '                   If third column = TempDATE then ...
                            If OriginalWFD_Array(ArrayRow, 4) = TempValue Then                                      '                       If fourth column = TempValue then
                                OriginalWFD_Array(CheckForDuplicateRow, 5) = "DUPLICATE"                            '                           We have found a match, set 5th column to 'DUPLICATE'
                                OriginalWFD_Array(ArrayRow, 5) = "DUPLICATE"                                        '                           We have found a match, set 5th column to 'DUPLICATE'
                            End If
                        End If
                    End If
                End If
            End If
        Next                                                                                                        '   Loop back
    Next                                                                                                            ' Loop back
'
'--------------------------------------------------------------------------------------------------------------------
'
' Delete same entries in both sheets
    For CheckForDuplicateRow = 1 To UBound(OriginalTAB_Array, 1)                                                    ' Loop through all rows of OriginalTAB_Array
          TempNLC = OriginalTAB_Array(CheckForDuplicateRow, 1)                                                      '   Save value from first column of OriginalTAB_Array into TempNLC
        TempMC_NO = OriginalTAB_Array(CheckForDuplicateRow, 2)                                                      '   Save value from second column of OriginalTAB_Array into TempMC_NO
         TempDATE = OriginalTAB_Array(CheckForDuplicateRow, 3)                                                      '   Save value from third column of OriginalTAB_Array into TempDATE
        TempValue = OriginalTAB_Array(CheckForDuplicateRow, 4)                                                      '   Save value from fourth column of OriginalTAB_Array into TempValue
        DuplicateFound = False                                                                                      '   Set DuplicateFound = False
'
        For ArrayRow = 1 To UBound(OriginalWFD_Array, 1)                                                            '   Loop through all rows of OriginalWFD_Array
            If OriginalWFD_Array(ArrayRow, 1) <> vbNullString Then                                                  '       If first column in OriginalWFD_Array is NOT blank then ...
                If OriginalWFD_Array(ArrayRow, 1) = TempNLC Then                                                    '           If first column = TempNLC then ...
                    If OriginalWFD_Array(ArrayRow, 2) = TempMC_NO Then                                              '               If second column = TempMC_NO then ...
                        If OriginalWFD_Array(ArrayRow, 3) = TempDATE Then                                           '                   If third column = TempDATE then ...
                            If OriginalWFD_Array(ArrayRow, 4) = TempValue Then                                      '                       If fourth column = TempValue then
                                OriginalWFD_Array(ArrayRow, 1) = vbNullString                                       '                           We found a match so set first column to blank
                                OriginalTAB_Array(CheckForDuplicateRow, 1) = vbNullString                           '                           We found a match so set first column to blank
                                DuplicateFound = True                                                               '                           Set DuplicateFound = True
                                Exit For                                                                            '                           Exit this For Loop
                            End If
                        End If
                    End If
                End If
            End If
        Next                                                                                                        '   Loop back
'
        If DuplicateFound = False Then OriginalTAB_Array(CheckForDuplicateRow, 5) = "MISSING"                       '   If a Duplicate was NOT found then set column 5 = 'MISSING'
    Next                                                                                                            ' Loop back
'
'-------------------------------------------------------------------------------------------------------------------
'
' Find number of remaining entries in each array
    For ArrayRow = 1 To UBound(OriginalTAB_Array, 1)                                                                ' Loop through all rows of OriginalTAB_Array
        If OriginalTAB_Array(ArrayRow, 1) <> vbNullString Then TAB_Count = TAB_Count + 1                            '   If first column is NOT blank then Increment TAB_Count
    Next                                                                                                            ' Loop back
'
    For ArrayRow = 1 To UBound(OriginalWFD_Array, 1)                                                                ' Loop through all rows of OriginalWFD_Array
        If OriginalWFD_Array(ArrayRow, 1) <> vbNullString Then WFD_Count = WFD_Count + 1                            '   If first column is NOT blank then Increment WFD_Count
    Next                                                                                                            ' Loop back
'
    ReDim FinalTAB_Array(1 To TAB_Count, 1 To 5) As Variant                                                         ' Set number of rows & columns for FinalTAB_Array
    ReDim FinalWFD_Array(1 To WFD_Count, 1 To 5) As Variant                                                         ' Set number of rows & columns for FinalWFD_Array
'
    For ArrayRow = 1 To UBound(OriginalTAB_Array, 1)                                                                ' Loop through all rows of OriginalTAB_Array
        If OriginalTAB_Array(ArrayRow, 1) <> vbNullString Then                                                      '   If first column is NOT blank then ...
            FinalArrayRow = FinalArrayRow + 1                                                                       '       Increment FinalArrayRow
'
            FinalTAB_Array(FinalArrayRow, 1) = OriginalTAB_Array(ArrayRow, 1)                                       '       Save First column into First column of FinalTAB_Array
            FinalTAB_Array(FinalArrayRow, 2) = OriginalTAB_Array(ArrayRow, 2)                                       '       Save Second column into Second column of FinalTAB_Array
            FinalTAB_Array(FinalArrayRow, 3) = OriginalTAB_Array(ArrayRow, 3)                                       '       Save Third column into Third column of FinalTAB_Array
            FinalTAB_Array(FinalArrayRow, 4) = OriginalTAB_Array(ArrayRow, 4)                                       '       Save Fourth column into Fourth column of FinalTAB_Array
            FinalTAB_Array(FinalArrayRow, 5) = OriginalTAB_Array(ArrayRow, 5)                                       '       Save Fifth column into Fifth column of FinalTAB_Array
        End If
    Next                                                                                                            ' Loop back
'
    FinalArrayRow = 0                                                                                               ' Reset FinalArrayRow back to zero
'
    For ArrayRow = 1 To UBound(OriginalWFD_Array, 1)                                                                ' Loop through all rows of OriginalWFD_Array
        If OriginalWFD_Array(ArrayRow, 1) <> vbNullString Then                                                      '   If first column is NOT blank then ...
            FinalArrayRow = FinalArrayRow + 1                                                                       '       Increment FinalArrayRow
'
            FinalWFD_Array(FinalArrayRow, 1) = OriginalWFD_Array(ArrayRow, 1)                                       '       Save First column into First column of FinalWFD_Array
            FinalWFD_Array(FinalArrayRow, 2) = OriginalWFD_Array(ArrayRow, 2)                                       '       Save Second column into Second column of FinalWFD_Array
            FinalWFD_Array(FinalArrayRow, 3) = OriginalWFD_Array(ArrayRow, 3)                                       '       Save Third column into Third column of FinalWFD_Array
            FinalWFD_Array(FinalArrayRow, 4) = OriginalWFD_Array(ArrayRow, 4)                                       '       Save Fourth column into Fourth column of FinalWFD_Array
            FinalWFD_Array(FinalArrayRow, 5) = OriginalWFD_Array(ArrayRow, 5)                                       '       Save Fifth column into Fifth column of FinalWFD_Array
        End If
    Next                                                                                                            ' Loop back
'
    Sheets("TAB").Range("G2").Resize(UBound(FinalTAB_Array, 1), UBound(FinalTAB_Array, 2)) = FinalTAB_Array         ' Display FinalTAB_Array to 'TAB' sheet
    Sheets("WFD").Range("G2").Resize(UBound(FinalWFD_Array, 1), UBound(FinalWFD_Array, 2)) = FinalWFD_Array         ' Display FinalWFD_Array to 'WFD' sheet
'
    Sheets("TAB").Range("J:J").NumberFormat = """£""#,##0.00;[Red]-""£""#,##0.00"                                   ' Format the currency column in 'TAB' sheet
    Sheets("WFD").Range("J:J").NumberFormat = """£""#,##0.00;[Red]-""£""#,##0.00"                                   ' Format the currency column in 'WFD' sheet
'
    Sheets("TAB").UsedRange.EntireColumn.AutoFit                                                                    ' Autofit the columns in the 'TAB' sheet
    Sheets("WFD").UsedRange.EntireColumn.AutoFit                                                                    ' Autofit the columns in the 'WFD' sheet
End Sub

 

[Leo Skywalker]

Try this:

Sub DeleteRepeatedRows()
Dim RowTAB, RowWFD As Long
Dim TAB1, TAB2, TAB3, TAB4 As Variant
Dim WFD1, WFD2, WFD3, WFD4 As Variant

For RowTAB = 1 To Sheets("TAB").Cells(Sheets("TAB").Rows.Count, 1).End(xlUp).Row
    For RowWFD = 1 To Sheets("WFD").Cells(Sheets("WFD").Rows.Count, 1).End(xlUp).Row
       
        TAB1 = Sheets("TAB").Cells(RowTAB, 1).Value2
        TAB2 = Sheets("TAB").Cells(RowTAB, 2).Value2
        TAB3 = Sheets("TAB").Cells(RowTAB, 3).Value2
        TAB4 = Sheets("TAB").Cells(RowTAB, 4).Value2
       
        WFD1 = Sheets("WFD").Cells(RowWFD, 1).Value2
        WFD2 = Sheets("WFD").Cells(RowWFD, 2).Value2
        WFD3 = Sheets("WFD").Cells(RowWFD, 3).Value2
        WFD4 = Sheets("WFD").Cells(RowWFD, 4).Value2
        
        If TAB1 = WFD1 And TAB2 = WFD2 And TAB3 = WFD3 And TAB4 = WFD4 Then
            Sheets("WFD").Cells(RowWFD, 1).EntireRow.Delete
            Sheets("TAB").Cells(RowTAB, 1).EntireRow.Delete
        End If
   
    Next RowWFD
Next RowTAB

End Sub

 

[Leo Skywalker]

I just amended the code, please use this:

Sub DeleteRepeatedRows()
Dim RowTAB, RowWFD As Long
Dim TAB1, TAB2, TAB3, TAB4 As Variant
Dim WFD1, WFD2, WFD3, WFD4 As Variant

For RowTAB = 1 To Sheets("TAB").Cells(Sheets("TAB").Rows.Count, 1).End(xlUp).Row
    For RowWFD = 1 To Sheets("WFD").Cells(Sheets("WFD").Rows.Count, 1).End(xlUp).Row
        
        TAB1 = Sheets("TAB").Cells(RowTAB, 1).Value2
        TAB2 = Sheets("TAB").Cells(RowTAB, 2).Value2
        TAB3 = Sheets("TAB").Cells(RowTAB, 3).Value2
        TAB4 = Sheets("TAB").Cells(RowTAB, 4).Value2
        
        WFD1 = Sheets("WFD").Cells(RowWFD, 1).Value2
        WFD2 = Sheets("WFD").Cells(RowWFD, 2).Value2
        WFD3 = Sheets("WFD").Cells(RowWFD, 3).Value2
        WFD4 = Sheets("WFD").Cells(RowWFD, 4).Value2
         
        If TAB1 = WFD1 And TAB2 = WFD2 And TAB3 = WFD3 And TAB4 = WFD4 Then
            Sheets("WFD").Cells(RowWFD, 1).EntireRow.Delete
            Sheets("TAB").Cells(RowTAB, 1).EntireRow.Delete
            RowTAB = RowTAB - 1
            GoTo NewCheck
        End If
    Next RowWFD
NewCheck:
Next RowTAB

End Sub

 

[kevin9999]

Another option to try on a copy of your data.

Option Explicit
Sub ghrek()
    Application.ScreenUpdating = False
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("TAB")
    Set ws2 = Worksheets("WFD")
    
    Dim LRow1 As Long, LRow2 As Long, i As Long
    LRow1 = ws1.Cells(Rows.Count, 1).End(3).Row
    LRow2 = ws2.Cells(Rows.Count, 1).End(3).Row
    
    Dim LCol1 As Long, LCol2 As Long
    LCol1 = ws1.Cells.Find("*", , xlFormulas, , 2, 2).Column + 1
    LCol2 = ws2.Cells.Find("*", , xlFormulas, , 2, 2).Column + 1
    ws1.Columns(LCol1).ColumnWidth = 30
    ws2.Columns(LCol2).ColumnWidth = 30
    
    Dim ArrIn1, ArrIn2, ArrOut1, ArrrOut2
    
    ArrIn1 = ws1.Evaluate(Replace("A2:A#&"" | ""&B2:B#&"" | ""&C2:C#&"" | ""&D2:D#", "#", LRow1))
    ws1.Cells(2, LCol1).Resize(UBound(ArrIn1, 1)).Value = ArrIn1
    ArrIn2 = ws2.Evaluate(Replace("A2:A#&"" | ""&B2:B#&"" | ""&C2:C#&"" | ""&D2:D#", "#", LRow2))
    ws2.Cells(2, LCol2).Resize(UBound(ArrIn2, 1)).Value = ArrIn2
    
    ReDim ArrOut1(1 To LRow1, 1 To 1)
    ReDim ArrOut2(1 To LRow2, 1 To 1)
    
    Dim Rng1 As Range, Rng2 As Range
    Set Rng1 = ws1.Cells(2, LCol1).CurrentRegion
    Set Rng2 = ws2.Cells(2, LCol2).CurrentRegion
    
    For i = 1 To UBound(ArrIn1, 1)
        If WorksheetFunction.CountIf(Rng1, ArrIn1(i, 1)) = 1 And WorksheetFunction.CountIf(Rng2, ArrIn1(i, 1)) = 1 Then
            ArrOut1(i, 1) = 1
        End If
    Next i
    ReDim ArrOut2(1 To LRow2, 1 To 1)
    For i = 1 To UBound(ArrIn2, 1)
        If WorksheetFunction.CountIf(Rng2, ArrIn2(i, 1)) = 1 And WorksheetFunction.CountIf(Rng1, ArrIn2(i, 1)) = 1 Then
            ArrOut2(i, 1) = 1
        End If
    Next i
    ws1.Cells(2, LCol1).Resize(UBound(ArrOut1, 1)).Value = ArrOut1
    ws2.Cells(2, LCol2).Resize(UBound(ArrOut2, 1)).Value = ArrOut2
    
    i = WorksheetFunction.Sum(ws1.Columns(LCol1))
    ws1.Range(ws1.Cells(2, 1), ws1.Cells(LRow1, LCol1)).Sort Key1:=ws1.Cells(2, LCol1), order1:=1, Header:=2
    If i > 0 Then ws1.Cells(2, LCol1).Resize(i).EntireRow.Delete
    ws1.Columns(LCol1).EntireColumn.Delete
    
    i = WorksheetFunction.Sum(ws2.Columns(LCol2))
    ws2.Range(ws2.Cells(2, 1), ws2.Cells(LRow2, LCol2)).Sort Key1:=ws2.Cells(2, LCol2), order1:=1, Header:=2
    If i > 0 Then ws2.Cells(2, LCol2).Resize(i).EntireRow.Delete
    ws2.Columns(LCol2).EntireColumn.Delete
    
    ws1.Range("A1").CurrentRegion.RemoveDuplicates Columns:=Array(1, 2, 3, 4), Header:=xlYes
    ws2.Range("A1").CurrentRegion.RemoveDuplicates Columns:=Array(1, 2, 3, 4), Header:=xlYes
    Application.ScreenUpdating = True
End Sub