Make cell color green, unless it's already green, then make It yellow

rudogg

New Member
Joined
Mar 18, 2022
Messages
28
Office Version
  1. 365
Platform
  1. Windows
See the line in Orange for my note. Any help would be appreciated!!

VBA Code:
Sub Match_MPN_Change_OurPrice()

    Workbooks(2).Worksheets(1).Activate

    Dim Cl As Range, mydiffs As Integer, matcheddata As Integer
     Dim Dic As Object

    Set Dic = CreateObject("scripting.dictionary")
    With Sheets(3)
        For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
            If Cl.Value <> "" Then
                Dic(Cl.Value) = Cl.Offset(, 2).Value
            End If
        Next Cl
    End With
    With Sheets(1)
        For Each Cl In .Range("BX2", .Range("BX" & Rows.Count).End(xlUp))
            If Dic.Exists(Cl.Value) Then
               Cl.Interior.Color = vbGreen
               matcheddata = matcheddata + 1
                If Dic(Cl.Value) <> 0 And Dic(Cl.Value) <> 0# And Dic(Cl.Value) <> "n/a" And Dic(Cl.Value) <> "N/A" And Dic(Cl.Value) <> "-" And Dic(Cl.Value) <> Cl.Offset(, -58).Value Then
                  Cl.Offset(, -58).Value = Dic(Cl.Value)
[COLOR=rgb(251, 160, 38)]                  Cl.Offset(, -58).Interior.Color = vbGreen 'Unless the cell is already vbGreen, then I need to make the cell vbYellow[/COLOR]
                  mydiffs = mydiffs + 1
                End If

            End If
        Next Cl
    End With
    'Display a message box to demonstrate the differences
    MsgBox matcheddata & " MPN's Have Been Matched, And " & mydiffs & " 'Our Price' Prices Have Been Modified.", vbInformation
    
End Sub
 

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying
Maybe something like this (not tested).
VBA Code:
    If Dic(Cl.Value) <> 0 And Dic(Cl.Value) <> 0# And Dic(Cl.Value) <> "n/a" And Dic(Cl.Value) <> "N/A" _
    And Dic(Cl.Value) <> "-" And Dic(Cl.Value) <> Cl.Offset(, -58).Value Then
        With Cl.Offset(, -58)
            .Value = Dic(Cl.Value)
            If .Interior.Color = vbGreen Then
                .Interior.Color = vbYellow
            Else
                .Interior.Color = vbGreen
            End If
        End With
        mydiffs = mydiffs + 1
    End If
 
Upvote 0
Solution
Maybe something like this (not tested).
VBA Code:
    If Dic(Cl.Value) <> 0 And Dic(Cl.Value) <> 0# And Dic(Cl.Value) <> "n/a" And Dic(Cl.Value) <> "N/A" _
    And Dic(Cl.Value) <> "-" And Dic(Cl.Value) <> Cl.Offset(, -58).Value Then
        With Cl.Offset(, -58)
            .Value = Dic(Cl.Value)
            If .Interior.Color = vbGreen Then
                .Interior.Color = vbYellow
            Else
                .Interior.Color = vbGreen
            End If
        End With
        mydiffs = mydiffs + 1
    End If
Works for me!!! Thank you kindly!
 
Upvote 0

Forum statistics

Threads
1,223,243
Messages
6,170,964
Members
452,371
Latest member
Frana

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top