Delete the repeated code

[clarksonneo]

Hi,

In my marco below, this
i = x = "ROAD" Or x = "STREET"
j = InStr(mycell, "LONDON GARDEN") > 0 Or InStr(mycell, "SMALL SITE") > 0
appears twice.

I want to amend my marco below so that the code above appears once only.
I hope that when I update "i" and "j", I don't need to update both marcos for location 1 and location 2.
In each update, I hope that I just need to update "i" and "j" once.

The picture below is the expected result I want and it is produced by my original marco.

My next reply is the admentment I did. However, it doesn't work.

Thanks




Sub Highlight_Location()

Range("C4").Select
Range(Selection, Selection.End(xlDown)).Select


For Each Y In Selection

'---------------location1

mycell = Y.Value
mycellS = Split(mycell, " ", -1)

For Each x In mycellS

i = x = "ROAD" Or x = "STREET"
j = InStr(mycell, "LONDON GARDEN") > 0 Or InStr(mycell, "SMALL SITE") > 0

If i Then
Y.Interior.ColorIndex = 6
ElseIf j Then
Y.Interior.ColorIndex = 6
End If

Next

If Y.Interior.ColorIndex = 6 Then GoTo NextY

'---------------location2

mycell1 = Y.Offset(0, 1).Value
mycellS1 = Split(mycell1, " ", -1)


For Each x In mycellS1

i = x = "ROAD" Or x = "STREET"
j = InStr(mycell1, "LONDON GARDEN") > 0 Or InStr(mycell1, "SMALL SITE") > 0

If i Then
Y.Offset(0, 1).Interior.ColorIndex = 6
ElseIf j Then
Y.Offset(0, 1).Interior.ColorIndex = 6
End If

Next

NextY:
Next

End Sub

[clarksonneo]

The following marco is what I hope.
However, it doesn't work.

i = x = "ROAD" Or x = "STREET"
j = InStr(mycell, "LONDON GARDEN") > 0 Or InStr(mycell, "SMALL SITE") > 0

Appear once only

Sub Highlight_Location2()

Range("C4").Select
Range(Selection, Selection.End(xlDown)).Select


For Each Y In Selection

i = x = "ROAD" Or x = "STREET"
j = InStr(mycell, "LONDON GARDEN") > 0 Or InStr(mycell, "SMALL SITE") > 0


'---------------location1

mycell = Y.Value
mycellS = Split(mycell, " ", -1)

For Each x In mycellS

If i Then
Y.Interior.ColorIndex = 6
ElseIf j Then
Y.Interior.ColorIndex = 6
End If

Next

If Y.Interior.ColorIndex = 6 Then GoTo NextY

'---------------location2

mycell1 = Y.Offset(0, 1).Value
mycellS1 = Split(mycell1, " ", -1)


For Each x In mycellS1

If i Then
Y.Offset(0, 1).Interior.ColorIndex = 6
ElseIf j Then
Y.Offset(0, 1).Interior.ColorIndex = 6
End If

Next

NextY:
Next

End Sub

[mdmackillop]

Does upper/lower case matter?

[Paul_Hossler]

This looks through the rows and columns

I think I matched the critera you were using



Option Explicit
Sub Highlight_Location()
Dim rData As Range, rCol As Range, rRow As Range
Dim vCell As Variant
Dim i As Long


Set rData = ActiveSheet.Range("C4").CurrentRegion

For Each rCol In rData.Columns
For Each rRow In rCol.Cells

'ignore first row
If rRow.Row <> rData.Cells(1, 1).Row Then

If (InStr(UCase(rRow.Value), "LONDON GARDEN") > 0) Or (InStr(UCase(rRow.Value), "SMALL SITE") > 0) Then
rRow.Interior.ColorIndex = 6

Else
vCell = Split(rRow.Value, " ", -1)

For i = LBound(vCell) To UBound(vCell)
If UCase(vCell(i)) = "ROAD" Or UCase(vCell(i)) = "STREET" Then
rRow.Interior.ColorIndex = 6
Exit For
End If
Next i
End If
End If
Next
Next

End Sub


Paul

[clarksonneo]

Does upper/lower case matter?


YES

[clarksonneo]

This looks through the rows and columns

I think I matched the critera you were using



Option Explicit
Sub Highlight_Location()
Dim rData As Range, rCol As Range, rRow As Range
Dim vCell As Variant
Dim i As Long


Set rData = ActiveSheet.Range("C4").CurrentRegion

For Each rCol In rData.Columns
For Each rRow In rCol.Cells

'ignore first row
If rRow.Row <> rData.Cells(1, 1).Row Then

If (InStr(UCase(rRow.Value), "LONDON GARDEN") > 0) Or (InStr(UCase(rRow.Value), "SMALL SITE") > 0) Then
rRow.Interior.ColorIndex = 6

Else
vCell = Split(rRow.Value, " ", -1)

For i = LBound(vCell) To UBound(vCell)
If UCase(vCell(i)) = "ROAD" Or UCase(vCell(i)) = "STREET" Then
rRow.Interior.ColorIndex = 6
Exit For
End If
Next i
End If
End If
Next
Next

End Sub

Paul


Hi,

I match part of my critera.

I hope that when location 1 include the word "STREET" or "ROAD", then location 2 will be ingored.

So in my original marco, I used
If Y.Interior.ColorIndex = 6 Then Goto NextY


Ie, If the cell in location 1 is in yellow colour, we will move to next row and ingore the cell in location 2.







Thanks