I need a macro which analyses 2 columns (say B and D) . If same text is found
both in cell B1 and D1 (and so on) , keeps the row . If not , it delets the
row .

Same text meaning 1-5 words which should be the same except capitalisation
which should not matter

Hi,

Right click your sheet tab, view code and paste this in and run it

Sub stance()
Dim MyRange
Dim copyrange As Range
Dim lastrow As Long
lastrow = Cells(Cells.Rows.Count, "B").End(xlUp).Row
Set MyRange = Range("B1:B" & lastrow)
For Each c In MyRange
If InStr(1, c.Value, c.Offset(, 2).Value, vbTextCompare) < 1 Then

If copyrange Is Nothing Then
Set copyrange = c.EntireRow
Else
Set copyrange = Union(copyrange, c.EntireRow)
End If
End If
Next
If Not copyrange Is Nothing Then
copyrange.Delete
End If


End Sub

Mike

"andrei" wrote:

I need a macro which analyses 2 columns (say B and D) . If same text is found
both in cell B1 and D1 (and so on) , keeps the row . If not , it delets the
row .

Same text meaning 1-5 words which should be the same except capitalisation
which should not matter

Thanks ! It works

"Mike H" wrote:

Hi,

Right click your sheet tab, view code and paste this in and run it

Sub stance()
Dim MyRange
Dim copyrange As Range
Dim lastrow As Long
lastrow = Cells(Cells.Rows.Count, "B").End(xlUp).Row
Set MyRange = Range("B1:B" & lastrow)
For Each c In MyRange
If InStr(1, c.Value, c.Offset(, 2).Value, vbTextCompare) < 1 Then

If copyrange Is Nothing Then
Set copyrange = c.EntireRow
Else
Set copyrange = Union(copyrange, c.EntireRow)
End If
End If
Next
If Not copyrange Is Nothing Then
copyrange.Delete
End If


End Sub

Mike

"andrei" wrote:

I need a macro which analyses 2 columns (say B and D) . If same text is found
both in cell B1 and D1 (and so on) , keeps the row . If not , it delets the
row .

Same text meaning 1-5 words which should be the same except capitalisation
which should not matter

Thanks ! It works

Excellent news, glad I could help

"andrei" wrote:

Thanks ! It works

"Mike H" wrote:

Hi,

Right click your sheet tab, view code and paste this in and run it

Sub stance()
Dim MyRange
Dim copyrange As Range
Dim lastrow As Long
lastrow = Cells(Cells.Rows.Count, "B").End(xlUp).Row
Set MyRange = Range("B1:B" & lastrow)
For Each c In MyRange
If InStr(1, c.Value, c.Offset(, 2).Value, vbTextCompare) < 1 Then

If copyrange Is Nothing Then
Set copyrange = c.EntireRow
Else
Set copyrange = Union(copyrange, c.EntireRow)
End If
End If
Next
If Not copyrange Is Nothing Then
copyrange.Delete
End If


End Sub

Mike

"andrei" wrote:

I need a macro which analyses 2 columns (say B and D) . If same text is found
both in cell B1 and D1 (and so on) , keeps the row . If not , it delets the
row .

Same text meaning 1-5 words which should be the same except capitalisation
which should not matter

one more thing : If i need to compare B column with Q column instead of D
column , what changes in the macro should be done ?

Hi,

It's in this line

If InStr(1, c.Value, c.Offset(, 2).Value, vbTextCompare) < 1 Then


Column D is offset 2 columns from B so for Q change the offset to 15

If InStr(1, c.Value, c.Offset(, 15).Value, vbTextCompare) < 1 Then

Mike

"andrei" wrote:

one more thing : If i need to compare B column with Q column instead of D
column , what changes in the macro should be done ?

Yep , thanks .

"Mike H" wrote:

Hi,

It's in this line

If InStr(1, c.Value, c.Offset(, 2).Value, vbTextCompare) < 1 Then


Column D is offset 2 columns from B so for Q change the offset to 15

If InStr(1, c.Value, c.Offset(, 15).Value, vbTextCompare) < 1 Then

Mike

"andrei" wrote:

one more thing : If i need to compare B column with Q column instead of D
column , what changes in the macro should be done ?