Macro analyses cells in 2 columns . If same text found , keeps row
 

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

Macro analyses cells in 2 columns . If same text found , keeps row
 

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

Macro analyses cells in 2 columns . If same text found , keeps
 

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

Macro analyses cells in 2 columns . If same text found , keeps
 

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

Macro analyses cells in 2 columns . If same text found , keeps
 

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 ?

Macro analyses cells in 2 columns . If same text found , keeps
 

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 ?

Macro analyses cells in 2 columns . If same text found , keeps
 

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 ?