VBA code to manually find and replace

[farmerscott]

Hi Everybody,

I have the following code that looks for-

cells in Col A that is not vbGreen
cells in Col B that is not vbYellow
cells in Col C that is not vbBlue

Across Cols A,B and C are related records.

Sub check_tags_to_delete()
Dim lr As Long


With Sheets("Matches")

lr = Worksheets("matches").Cells(Rows.Count, "A").End(xlUp).Row

For x = 1 To lr Step 1

If .Range("A" & x).Interior.Color <> vbGreen Or .Range("B" & x).Interior.Color <> vbYellow Or .Range("C" & x).Interior.Color <> vbBlue Then
'do mannual find and replace here

End If
Next x
End With
End Sub

Because the records are contextual with the record above or below (that row) I would like to somehow go through the sheet where the code takes me to the next non coloured cell, I visually check it and if it is OK I click on Col A and it turns green, click on Col B it turns yellow and so on for Col C. Onto the next non coloured record. Something like the mannual find and replace except with colours within the cells.

Since I am learning how to write VBA I would prefer some guideance rather than written code. I think I can do the change in colours by a double click change event but I don't know how to stop the code, mannually do what I want to do then restart the code again.

Alternatively, would it just be easier to copy the non coloured cells (with the row above and below) to a separate sheet, then do the change of colours and then reinsert the changes back into my original list?

Any thoughts?

thanks

FarmerScott

 

[Hoozits]

I could be wrong, but it seems like you want to place your code in a Worksheet_Change() module.

 

[farmerscott]

Hoozits,

thanksfor the comment.

The following code does the mannual change on a double click, removes the colour on a right click. This part is working well. I just need he first part of my request.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 1 Then
ActiveCell.Interior.Color = vbGreen
End If
If Target.Column = 2 Then
ActiveCell.Interior.Color = vbYellow
End If
If Target.Column = 3 Then
ActiveCell.Interior.Color = vbBlue
End If
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 1 Then
With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
End With
End If
If Target.Column = 2 Then
With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
End With
End If
If Target.Column = 3 Then
With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
End With
End If
End Sub

thanks

FarmerScott

 

[farmerscott]

Sorry I was timed out on my editing...

Hoozits,

thanks for the comment. I have the "on change" code working.

The following code does the colour change on a double click, removes the colour on a right click. I just need the first part of my request.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 1 Then
ActiveCell.Interior.Color = vbGreen
End If
If Target.Column = 2 Then
ActiveCell.Interior.Color = vbYellow
End If
If Target.Column = 3 Then
ActiveCell.Interior.Color = vbBlue
End If
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 1 Then
With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
End With
End If
If Target.Column = 2 Then
With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
End With
End If
If Target.Column = 3 Then
With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
End With
End If
End Sub

I am going down the route of my alternate suggestion, where I have written a code to extract the information..(and is working).

Sub matches_checked()
Dim lr As Long
Dim lr2 As Long
 
With Sheets("incomplete matches checked")
lr = Worksheets("incomplete matches checked").Cells(Rows.Count, "A").End(xlUp).Row
For x = 1 To lr Step 1
If .Range("A" & x).Interior.Color = vbGreen Or .Range("B" & x).Interior.Color = vbYellow Or .Range("C" & x).Interior.Color = vbBlue Then
    lr2 = Worksheets("incomplete matches checked").Cells(Rows.Count, "A").End(xlUp).Row
    lr2 = lr2 + 2
    .Range("A" & x).Offset(-1, 0).Resize(3, 3).Copy Destination:=Sheets("incomplete matches checked").Range("A" & lr2)

End If
Next x
End With

I now need to write a code that compares each list with cells value and colour. If the cell values match then colour the second cell the same colour.

thanks

FarmerScott