Formula, vba, or logic to remove certain occurrences

[horees]

All,
I'm looking for a Formula, vba, or logic to remove certain occurrences of a pattern.

To make life easier, please see the table below.

I want A formula or logic to calculate the column D as shown below. The idea is to get as minimum of records that show x, zz, y, ww without repition.

i.e. to be able to identify the records of (x,zz) and (y,ww).

too hard???

Thank you

A	B	C	D
6/25	X	ZZ	1
6/25	X	WW	0
6/25	Y	ZZ	0
6/25	Y	WW	1

<TBODY>
</TBODY>

 

[Leandrial]

There are actually an "if" in there that does nothing... but I forgot to remove it... The If n > 0 doesnt do anything...

 

[horees]

There are actually an "if" in there that does nothing... but I forgot to remove it... The If n > 0 doesnt do anything...

I tried it on the provided example, it worked well, but after deleting the unneccesary rows, it gives the error "application-defined or object-defined error in this line
c = MyTable.Cells(a - 1, 1).Value

However, when I tried it on real data, it deleted some records that shouldn't be deleted...

can we do highlight entire row with color instead of deleting to be able to understand what is wrong?

Thank you

it looks like we are too close

 

[Leandrial]

def so.. but unfortunatly i have to go to bed now... (more or less there)... i have stuff to do tomorow morning.. but ill go at it again when i get back home... unless you solve it yourself in the meanwhile


Best regards

 

[horees]

def so.. but unfortunatly i have to go to bed now... (more or less there)... i have stuff to do tomorow morning.. but ill go at it again when i get back home... unless you solve it yourself in the meanwhile


Best regards

Sure thing, thanks though...very helpful...waiting for your coming back!

 

[mrmmickle1]

You may just try a helper column and some nested if statements. Sometimes the simple method is the best route.

 

[mrmmickle1]

Try this formula:

=IF(AND(B2="XX",C2="XX"), "MATCH", IF(AND(B2="YY",C2="YY"), "MATCH", IF(AND(B2="XX",C2="YY"), "MATCH", IF(AND(B2="YY",C2="XX"), "MATCH", "NO MATCH"))))

 

[mrmmickle1]

If you want to delete the items that don't match you could also use this vba:

Sub DelRowsNoMatch()
'Deletes rows based on the value "NO MATCH" in column D.  The values are determined after the formula is auto-populated in column D.
Dim lr As Long, i As Long

lr = Range("A" & Rows.Count).End(xlUp).Row

Range("D2:D" & lr).Formula = "=IF(AND(B2=""XX"",C2=""XX""), ""MATCH"", IF(AND(B2=""YY"",C2=""YY""), ""MATCH"", IF(AND(B2=""XX"",C2=""YY""), ""MATCH"", IF(AND(B2=""YY"",C2=""XX""), ""MATCH"", ""NO MATCH""))))"

For i = lr To 1 Step -1
    If Range("D" & i).Value = "NO MATCH" Then Rows(i).Delete
Next i

End Sub

 

[Leandrial]

If you want to delete the items that don't match you could also use this vba:

Sub DelRowsNoMatch()
'Deletes rows based on the value "NO MATCH" in column D.  The values are determined after the formula is auto-populated in column D.
Dim lr As Long, i As Long

lr = Range("A" & Rows.Count).End(xlUp).Row

Range("D2:D" & lr).Formula = "=IF(AND(B2=""XX"",C2=""XX""), ""MATCH"", IF(AND(B2=""YY"",C2=""YY""), ""MATCH"", IF(AND(B2=""XX"",C2=""YY""), ""MATCH"", IF(AND(B2=""YY"",C2=""XX""), ""MATCH"", ""NO MATCH""))))"

For i = lr To 1 Step -1
    If Range("D" & i).Value = "NO MATCH" Then Rows(i).Delete
Next i

End Sub

The problem is that the values XX, YY, WW and ZZ aint static values.. they can be anything... and not even the same from day to day...

Best regards

Leandrial

 

[Leandrial]

I tried it on the provided example, it worked well, but after deleting the unneccesary rows, it gives the error "application-defined or object-defined error in this line
c = MyTable.Cells(a - 1, 1).Value

However, when I tried it on real data, it deleted some records that shouldn't be deleted...

can we do highlight entire row with color instead of deleting to be able to understand what is wrong?

Thank you

it looks like we are too close

Hi again

Ya ill modify it so that it changes colour... Could you post the copy of the real data (ofc only if its not confidential)... would help for deducting the rules needed for the code to work correctly...


Best regards

leandrial

 

[Leandrial]

Here the code with the color changes...

It no longer deletes the rows we dont wanna keep.. only color them red

Sub RemoveRows()


Dim MyTable As Range
Dim ws As Worksheet
Dim RowCount As Integer
Dim b As String
Dim c As String
Dim x1 As String
Dim x2 As String
Dim x3 As String
Dim x4 As String
Dim x5 As String
Dim x6 As String
Dim x7 As String
Dim x8 As String
Dim n As Integer




Set ws = ActiveWorkbook.Worksheets("Sheet1")  'change Sheet1 to whatever the name of the worksheet
Set MyTable = ws.Range("Sample") 'change Sampe to whatever the name of the range




RowCount = MyTable.Rows.Count


For a = RowCount To 1 Step -1


    b = MyTable.Cells(a, 1).Value
    c = MyTable.Cells(a - 1, 1).Value
    
    If b = c Then
    
        n = n + 1
       
    Else
    
        If n = 3 Then
            
                x1 = MyTable.Cells(a, 2).Value
                x2 = MyTable.Cells(a, 3).Value
                x3 = MyTable.Cells(a + 1, 2).Value
                x4 = MyTable.Cells(a + 1, 3).Value
                x5 = MyTable.Cells(a + 2, 2).Value
                x6 = MyTable.Cells(a + 2, 3).Value
                x7 = MyTable.Cells(a + 3, 2).Value
                x8 = MyTable.Cells(a + 3, 3).Value
                
                If x1 = x2 And x3 = x4 Then
                
                    With MyTable.Rows(a + 3).Interior
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        .Color = 255
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                    
                    With MyTable.Rows(a + 2).Interior
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        .Color = 255
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                                    
                    n = 0
                
                Else
                
                    With MyTable.Rows(a + 2).Interior
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        .Color = 255
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                    
                    With MyTable.Rows(a + 1).Interior
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        .Color = 255
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                
                    n = 0
                    
                End If
            
        End If
    End If


Next


End Sub

Best regrads

Leandrial