Find value in another column, change Interior.colorIndex

[Gaba]

First post didn't work. I apologize if this is a duplicate.

Hello there,
I wrote the following code to find a value in column B if the cell in
columnS has an Interior.color.Index = 44, transfer the color to the cell with
same value in B.
(calcLastRow declared already)

Dim ColumnB As Range, SrcChk1 As Range
Dim DestChk1 As String
Dim DestChk2 As String

Set ColumnB = Range("B14", "B" & calcLastRow)
Range("N14").Select

With ColumnB
Do
DestChk1 = (ActiveCell.Offset(0, 5).Interior.ColorIndex = 44)
DestChk2 = Trim(ActiveCell.Offset(0, 0).Value)
Set SrcChk1 = .Find(What:=Trim(DestChk2), LookAt:=xlWhole,
SearchOrder:=xlByColumns)


On Error Resume Next
For Each c In ColumnB
If Not SrcChk1 Is Nothing Then
If c.Offset(0, 0).Value = Trim(DestChk2) Then
c.Offset(0, 2).Interior.ColorIndex = 44
c.Offset(1, 2).Interior.ColorIndex = 44

End If
Err.Clear

End If 'nothing
Next

ActiveCell.Offset(1, 0).Select
Loop Until IsEmpty(ActiveCell.Offset(0, 0))

End With

I can't find where I'm making the mistake... is going thru column N Offset
0, 5 (Column S has some null values) but is not finding the value on Column B.

Any help will be greatly appreciated!
Thanks
Gaba

 

[Don Guillett]

How about, not tested, something simpler such as
sub SAS()
dim i as long
for i = 1 to cells(rows.count,"b").end(xlup).row
if cells(i,"s")=cells(i,"b") and cells(i,"s").interior.colorindex=44 then
cells(i,"b").interior.colorindex=44
next i
end sub

 

[OssieMac]

Hi Gaba,

Don's code does not seem to do what it appears you are trying to achieve but
not sure. However, have a look at the comments in the following. Probably
best to copy it into your VBA editor so the comments are easy to see in green.

Sub test()
Dim ColumnB As Range, SrcChk1 As Range
'Following line should be boolean; not a string
'Dim DestChk1 As String
Dim DestChk1 As Boolean
Dim DestChk2 As String
Dim c As Range 'Added for testing

'*********************************************
'Lines between asterisks added for testing
Dim calcLastRow As Long
With ActiveSheet
calcLastRow = .Cells(.Rows.Count, "B") _
.End(xlUp).Row
End With
'**********************************************

Set ColumnB = Range("B14", "B" & calcLastRow)
Range("N14").Select

With ColumnB
Do
'Following line tests if colorindex = 44
'and returns True or False.
DestChk1 = (ActiveCell.Offset(0, 5) _
.Interior.ColorIndex = 44)
'What do you want the code to do depending
'on whether DestChk1 is True or False.
'suggest following
If DestChk1 = False Then
MsgBox "Required cell interior color not 44." _
& vbLf & "Processing terminated."
Exit Sub
End If

'Offset(0, 0) is no offset so not required
'DestChk2 = Trim(ActiveCell.Offset(0, 0).Value)
DestChk2 = Trim(ActiveCell.Value)

Set SrcChk1 = .Find(What:=Trim(DestChk2), _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns)

'If SrcChk1 is Nothing then For Each
'not required so needs to be before
'the For Each loop.
If Not SrcChk1 Is Nothing Then

'On Error Resume Next 'Not required
For Each c In ColumnB
'Next line moved to before the For loop
'If Not SrcChk1 Is Nothing Then
If c.Offset(0, 0).Value = Trim(DestChk2) Then
c.Offset(0, 2).Interior.ColorIndex = 44
c.Offset(1, 2).Interior.ColorIndex = 44
End If
'Err.Clear 'Not required

'End If 'Moved outside loop
Next
Else
'No point in continuing if SrcChk1 is nothing
Exit Sub
End If
ActiveCell.Offset(1, 0).Select
'Offset(0, 0) is no offset so not required
'Loop Until IsEmpty(ActiveCell.Offset(0, 0))
Loop Until IsEmpty(ActiveCell)
End With
End Sub

 

[Mishell]

The Find method is a little bit tricky to use.

In your case, you could use CountIf instead.
Like this:

Dim ColumnB As Range, SrcChk1 As Range
Dim DestChk1 As String
Dim DestChk2 As String

Set ColumnB = Range("B14", "B" & calcLastRow)
Range("N14").Select

With ColumnB
Do
DestChk1 = (ActiveCell.Offset(0, 5).Interior.ColorIndex = 44)
DestChk2 = Trim(ActiveCell.Offset(0, 0).Value)
' Set SrcChk1 = .Find(What:=Trim(DestChk2), LookAt:=xlWhole,
SearchOrder:=xlByColumns)

n = Application.CountIf(ColumnB, _
Trim(CStr(DestChk2)))

On Error Resume Next
If Not n = 0 Then
For Each c In ColumnB

If Trim(CStr(c.Offset(0, 0).Value)) = Trim(DestChk2) Then
c.Offset(0, 2).Interior.ColorIndex = 44
c.Offset(1, 2).Interior.ColorIndex = 44

End If
Err.Clear


Next
End If

ActiveCell.Offset(1, 0).Select
Loop Until IsEmpty(ActiveCell.Offset(0, 0))

End With

Mishell

 

[Gaba]

Thanks so much Don. I've changed a little and it is working. Fewer lines,
doing the same job.
Gaba