VBA Macro to autofill coloured cells with specific text

[Elle9876]

Hi All,

I am really new to VBA coding. I have large spreadsheets that contain thousands of cells that have been coloured, but not via conditional formatting.
I need to autofill these cells dependent on the RGB code, with specific text, back into the cell that is coloured. I have tried two Macros so far that I found online, one I couldn't make work as I didn't and still do not understand how to write a Sub to support the Function. The other works, but it lists the wording into the column beside the cell that coloured. (Both below)

Function VBA code:
Function CheckColor1(r as Range)
If r.Interior.Color = RGB(255, 192, 0) Then
CheckColor1 = "Orange"
ElseIf r.Interior.Color = RGB(0, 176, 240) Then
CheckColor1 = "Blue"
ElseIf r.Interior.Color = RGB(255, 255, 0) Then
CheckColor1 = "Yellow"
Else
CheckColor1 = " "
End If
End Function

Sub Macro aligned to the side:
Sub What_Color()
Application.ScreenUpdating = False
Dim i As Integer
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To Lastrow
If Cells(i, 1).Interior.Color = RGB(255, 255, 0) Then Cells(i, 2).Value = "Yellow"
If Cells(i, 1).Interior.Color = RGB(148, 138, 34) Then Cells(i, 2).Value = "Brown"
Next
Application.ScreenUpdating = True
End Sub


Below are two attempts that I have made after reviewing different posts and these , neither work unsurprisingly:

Attempt 1:
Sub CT()
Application.ScreenUpdating = False
Dim R As Range
Set R = ActiveSheet.Range("A1:G10")
If R.Interior.Color = RGB(255, 192, 0) Then Cells.Value = "Orange"
If R.Interior.Color = RGB(0, 176, 240) Then Cells.Value = "Blue"
If R.Interior.Color = RGB(255, 255, 0) Then Cells.Value = "Yellow"
Application.ScreenUpdating = True
End Sub

Attempt 2:
Sub Colour ()
Application.ScreenUpdating = False
Dim i As Integer
Dim x as Range
Set x = Worksheets("Sheet name").Cells
Dim ws As Worksheet
Set ws = ActiveSheet
For i = 1 To Lastrow
If Cells(i, 1).Interior.Color = RGB(255, 192, 0) Then Cells(i, 1).Value = "Orange"
If Cells(i, 1).Interior.Color = RGB(0, 176, 240) Then Cells(i, 1).Value = "Blue"
If Cells(i, 1).Interior.Color = RGB(255, 255, 0) Then Cells(i, 1).Value = "Yellow"
Next
Application.ScreenUpdating = True
End Sub

Any help / advice would be sincerely appreciated

 

[Peter_SSs]

Welcome to the MrExcel board!

Try this with a copy of your workbook.

Sub AddTextToColouredCells()
  Dim rFound As Range
  Dim Clrs(1 To 3) As Long, i As Long
  Dim Txts(1 To 3) As String, FirstAddr As String
  
  Clrs(1) = RGB(255, 192, 0)
  Clrs(2) = RGB(0, 176, 240)
  Clrs(3) = RGB(255, 255, 0)
  Txts(1) = "Orange"
  Txts(2) = "Blue"
  Txts(3) = "Yellow"
  Application.ScreenUpdating = False
  For i = 1 To UBound(Clrs)
    Application.FindFormat.Clear
    Application.FindFormat.Interior.Color = Clrs(i)
    Set rFound = Cells.Find(What:="*", SearchFormat:=True)
    If Not rFound Is Nothing Then
      FirstAddr = rFound.Address
      Do
        rFound.Value = Txts(i)
        Set rFound = Cells.Find(What:="*", After:=rFound, SearchFormat:=True)
      Loop Until rFound.Address = FirstAddr
    End If
  Next i
  Application.FindFormat.Clear
  Application.ScreenUpdating = True
End Sub

 

[Elle9876]

Apologies for the delay in responding, I have tried now, but it still doesn't seem to work?

 

[johnnyL]

@Elle9876 I have edited the macro that you said worked, but it was putting the text to the side of the colored cell. I put comments in the code also to explain a bit of what it is doing. Right now it is set up to look through the A:G range, but you can edit that to your specific needs.

Sub What_ColorV2()
'
    Application.ScreenUpdating = False                                                                              ' Turn off ScreenUpdating to speed up process
'
    Dim LastRowInSheet  As Long
    Dim RowNumber       As Long
    Dim Cell            As Range
'
    LastRowInSheet = Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row                                      ' Get number of last used row in the sheet
'
    For Each Cell In Range("A1:G" & LastRowInSheet)                                                                 ' Loop through range entered
        If Cell.Interior.Color = RGB(255, 192, 0) Then Cell.Value = "Orange"                                        '   If Color found then insert text into cell
        If Cell.Interior.Color = RGB(0, 176, 240) Then Cell.Value = "Blue"                                          '   If Color found then insert text into cell
        If Cell.Interior.Color = RGB(255, 255, 0) Then Cell.Value = "Yellow"                                        '   If Color found then insert text into cell
    Next                                                                                                            ' Loop back
'
    Application.ScreenUpdating = True                                                                               ' Turn ScreenUpdating back on
End Sub