Avatar of Trygve Thayer
Trygve Thayer
Flag for United States of America asked on

How to Copy to textbox and change color based on value in another cell and not get procedure is too large.

I have a spreadsheet that I am copying 2 columns from another data source.  There can be up to 200 rows.  What I am trying to do is create a macro that will copy the text from column B to a textbox in Column C and then turn the background color of the box based on the data in column A.  Column data is from a value  of blank, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10

I have code I have tried but the error indicates the procedure is too large.  Below is what I have for the first 6 rows.  Hoping there is a way to simplify so it will run.


Sub CreateBlocks()
'
' CreateBlocks Macro
' CreateBlocks

Dim Txt As String
Dim Stp As String



    Txt = Range("B3").Value
    Stp = Range("A3").Value
    ActiveSheet.Shapes("TextBox 3").TextFrame2.TextRange.Characters.Text = Txt
    ActiveSheet.Shapes.Range(Array("TextBox 3")).Select
        With Selection.ShapeRange.Fill
            If Stp = "1" Then
                .ForeColor.RGB = RGB(255, 255, 0)
            ElseIf Stp = "2" Then
                .ForeColor.RGB = RGB(0, 176, 80)
            ElseIf Stp = "3" Then
                .ForeColor.RGB = RGB(255, 153, 255)
            ElseIf Stp = "4" Then
                .ForeColor.RGB = RGB(255, 113, 17)
            ElseIf Stp = "5" Then
                .ForeColor.RGB = RGB(0, 76, 240)
            ElseIf Stp = "6" Then
                .ForeColor.RGB = RGB(204, 0, 255)
            ElseIf Stp = "7" Then
                .ForeColor.RGB = RGB(255, 0, 0)
            ElseIf Stp = "8" Then
                .ForeColor.RGB = RGB(102, 51, 0)
            ElseIf Stp = "9" Then
                .ForeColor.RGB = RGB(191, 191, 191)
            ElseIf Stp = "10" Then
                .ForeColor.RGB = RGB(23, 55, 94)
            ElseIf Stp = "" Then
                .ForeColor.RGB = RGB(255, 255, 255)
            End If
        End With
    
    Txt = Range("B4").Value
    Stp = Range("A4").Value
    ActiveSheet.Shapes("TextBox 4").TextFrame2.TextRange.Characters.Text = Txt
    ActiveSheet.Shapes.Range(Array("TextBox 3")).Select
        With Selection.ShapeRange.Fill
            If Stp = "1" Then
                .ForeColor.RGB = RGB(255, 255, 0)
            ElseIf Stp = "2" Then
                .ForeColor.RGB = RGB(0, 176, 80)
            ElseIf Stp = "3" Then
                .ForeColor.RGB = RGB(255, 153, 255)
            ElseIf Stp = "4" Then
                .ForeColor.RGB = RGB(255, 113, 17)
            ElseIf Stp = "5" Then
                .ForeColor.RGB = RGB(0, 76, 240)
            ElseIf Stp = "6" Then
                .ForeColor.RGB = RGB(204, 0, 255)
            ElseIf Stp = "7" Then
                .ForeColor.RGB = RGB(255, 0, 0)
            ElseIf Stp = "8" Then
                .ForeColor.RGB = RGB(102, 51, 0)
            ElseIf Stp = "9" Then
                .ForeColor.RGB = RGB(191, 191, 191)
            ElseIf Stp = "10" Then
                .ForeColor.RGB = RGB(23, 55, 94)
            ElseIf Stp = "" Then
                .ForeColor.RGB = RGB(255, 255, 255)
            End If
        End With
    
    Txt = Range("B5").Value
    Stp = Range("A5").Value
    ActiveSheet.Shapes("TextBox 5").TextFrame2.TextRange.Characters.Text = Txt
    ActiveSheet.Shapes.Range(Array("TextBox 3")).Select
        With Selection.ShapeRange.Fill
            If Stp = "1" Then
                .ForeColor.RGB = RGB(255, 255, 0)
            ElseIf Stp = "2" Then
                .ForeColor.RGB = RGB(0, 176, 80)
            ElseIf Stp = "3" Then
                .ForeColor.RGB = RGB(255, 153, 255)
            ElseIf Stp = "4" Then
                .ForeColor.RGB = RGB(255, 113, 17)
            ElseIf Stp = "5" Then
                .ForeColor.RGB = RGB(0, 76, 240)
            ElseIf Stp = "6" Then
                .ForeColor.RGB = RGB(204, 0, 255)
            ElseIf Stp = "7" Then
                .ForeColor.RGB = RGB(255, 0, 0)
            ElseIf Stp = "8" Then
                .ForeColor.RGB = RGB(102, 51, 0)
            ElseIf Stp = "9" Then
                .ForeColor.RGB = RGB(191, 191, 191)
            ElseIf Stp = "10" Then
                .ForeColor.RGB = RGB(23, 55, 94)
            ElseIf Stp = "" Then
                .ForeColor.RGB = RGB(255, 255, 255)
            End If
        End With
    Txt = Range("B6").Value
    Stp = Range("A6").Value
    ActiveSheet.Shapes("TextBox 7").TextFrame2.TextRange.Characters.Text = Txt
    ActiveSheet.Shapes.Range(Array("TextBox 3")).Select
        With Selection.ShapeRange.Fill
            If Stp = "1" Then
                .ForeColor.RGB = RGB(255, 255, 0)
            ElseIf Stp = "2" Then
                .ForeColor.RGB = RGB(0, 176, 80)
            ElseIf Stp = "3" Then
                .ForeColor.RGB = RGB(255, 153, 255)
            ElseIf Stp = "4" Then
                .ForeColor.RGB = RGB(255, 113, 17)
            ElseIf Stp = "5" Then
                .ForeColor.RGB = RGB(0, 76, 240)
            ElseIf Stp = "6" Then
                .ForeColor.RGB = RGB(204, 0, 255)
            ElseIf Stp = "7" Then
                .ForeColor.RGB = RGB(255, 0, 0)
            ElseIf Stp = "8" Then
                .ForeColor.RGB = RGB(102, 51, 0)
            ElseIf Stp = "9" Then
                .ForeColor.RGB = RGB(191, 191, 191)
            ElseIf Stp = "10" Then
                .ForeColor.RGB = RGB(23, 55, 94)
            ElseIf Stp = "" Then
                .ForeColor.RGB = RGB(255, 255, 255)
            End If
        End With
        
    Txt = Range("B7").Value
    Stp = Range("A7").Value
    ActiveSheet.Shapes("TextBox 8").TextFrame2.TextRange.Characters.Text = Txt
    ActiveSheet.Shapes.Range(Array("TextBox 3")).Select
        With Selection.ShapeRange.Fill
            If Stp = "1" Then
                .ForeColor.RGB = RGB(255, 255, 0)
            ElseIf Stp = "2" Then
                .ForeColor.RGB = RGB(0, 176, 80)
            ElseIf Stp = "3" Then
                .ForeColor.RGB = RGB(255, 153, 255)
            ElseIf Stp = "4" Then
                .ForeColor.RGB = RGB(255, 113, 17)
            ElseIf Stp = "5" Then
                .ForeColor.RGB = RGB(0, 76, 240)
            ElseIf Stp = "6" Then
                .ForeColor.RGB = RGB(204, 0, 255)
            ElseIf Stp = "7" Then
                .ForeColor.RGB = RGB(255, 0, 0)
            ElseIf Stp = "8" Then
                .ForeColor.RGB = RGB(102, 51, 0)
            ElseIf Stp = "9" Then
                .ForeColor.RGB = RGB(191, 191, 191)
            ElseIf Stp = "10" Then
                .ForeColor.RGB = RGB(23, 55, 94)
            ElseIf Stp = "" Then
                .ForeColor.RGB = RGB(255, 255, 255)
            End If
        End With
        
    Txt = Range("B8").Value
    Stp = Range("A8").Value
    ActiveSheet.Shapes("TextBox 10").TextFrame2.TextRange.Characters.Text = Txt
    ActiveSheet.Shapes.Range(Array("TextBox 3")).Select
        With Selection.ShapeRange.Fill
            If Stp = "1" Then
                .ForeColor.RGB = RGB(255, 255, 0)
            ElseIf Stp = "2" Then
                .ForeColor.RGB = RGB(0, 176, 80)
            ElseIf Stp = "3" Then
                .ForeColor.RGB = RGB(255, 153, 255)
            ElseIf Stp = "4" Then
                .ForeColor.RGB = RGB(255, 113, 17)
            ElseIf Stp = "5" Then
                .ForeColor.RGB = RGB(0, 76, 240)
            ElseIf Stp = "6" Then
                .ForeColor.RGB = RGB(204, 0, 255)
            ElseIf Stp = "7" Then
                .ForeColor.RGB = RGB(255, 0, 0)
            ElseIf Stp = "8" Then
                .ForeColor.RGB = RGB(102, 51, 0)
            ElseIf Stp = "9" Then
                .ForeColor.RGB = RGB(191, 191, 191)
            ElseIf Stp = "10" Then
                .ForeColor.RGB = RGB(23, 55, 94)
            ElseIf Stp = "" Then
                .ForeColor.RGB = RGB(255, 255, 255)
            End If
        End With

Open in new window


VB ScriptVBAMicrosoft ExcelMicrosoft Office

Avatar of undefined
Last Comment
Trygve Thayer

8/22/2022 - Mon
Norie

You could vastly reduce the length of the posted code by looping through the cells/textboxes and using a dictionary for the colours.
Option Explicit

Sub CreateBlocks()
'
' CreateBlocks Macro
' CreateBlocks
Dim dicStp As Object
Dim Txt As String
Dim Stp As String
Dim idx As Long
Dim idTextBox As Variant

    idTextBox = Array("TextBox 3", "TextBox 4", "TextBox 5", _
                      "TextBox 7", "TextBox 8", "TextBox 10")
    Set dicStp = CreateObject("Scripting.Dictionary")

    dicStp("1") = RGB(255, 255, 0)
    dicStp("2") = RGB(0, 176, 80)
    ' fill in rest
    dicStp("10") = RGB(23, 55, 94)

    For idx = :LBound(idTextBox) To UBound(idTextBox)

        Txt = Range("B" & idx + 3).Value
        Stp = Range("A3" & idx + 3).Value
        ActiveSheet.Shapes(idTextBox(idx)).TextFrame2.TextRange.Characters.Text = Txt
        ActiveSheet.Shapes.Range(idTextBox(idx)).Select
        With Selection.ShapeRange.Fill
            If Stp = "" Then
                .ForeColor.RGB = RGB(255, 255, 255)
            Else
                .ForeColor.RGB = dicStp(Stp)
            End If
        End With

    Next idx

End Sub

Open in new window

Trygve Thayer

ASKER
Thanks I will try that as they want this thing working by Monday so I have no weekend without others help at Experts-Exchange
Trygve Thayer

ASKER
So here is the code I have so far.  I am not sure what the Next IDX is suppose to look like as I am not familiar with arrays.

Option Explicit

Sub CreateBlocks()
'
' CreateBlocks Macro
' CreateBlocks
Dim dicStp As Object
Dim Txt As String
Dim Stp As String
Dim idx As Long
Dim idTextBox As Variant

    idTextBox = Array("TextBox 3", "TextBox 4", "TextBox 5", "TextBox 7", "TextBox 8", "TextBox 10", "TextBox 12", "TextBox 13", _
                    "TextBox 15", "TextBox 17", "TextBox 18", "TextBox 19", "TextBox 20", "TextBox 21", "TextBox 22", "TextBox 23", _
                    "TextBox 24", "TextBox 25", "TextBox 26", "TextBox 27", "TextBox 28", "TextBox 29", "TextBox 30", "TextBox 31", _
                    "TextBox 32", "TextBox 33", "TextBox 34", "TextBox 36", "TextBox 37", "TextBox 38", "TextBox 40", "TextBox 42", _
                    "TextBox 43", "TextBox 44", "TextBox 45", "TextBox 46", "TextBox 47", "TextBox 48", "TextBox 49", "TextBox 50", _
                    "TextBox 51", "TextBox 52", "TextBox 54", "TextBox 55", "TextBox 57", "TextBox 58", "TextBox 60", "TextBox 61", _
                    "TextBox 62", "TextBox 64", "TextBox 65", "TextBox 67", "TextBox 69", "TextBox 70", "TextBox 71", "TextBox 72", _
                    "TextBox 73", "TextBox 74", "TextBox 76", "TextBox 77", "TextBox 79", "TextBox 81", "TextBox 82", "TextBox 83", _
                    "TextBox 84", "TextBox 86", "TextBox 87", "TextBox 89", "TextBox 90", "TextBox 91", "TextBox 92", "TextBox 93", _
                    "TextBox 95", "TextBox 96", "TextBox 97", "TextBox 98", "TextBox 100", "TextBox 102", "TextBox 103", "TextBox 104", _
                    "TextBox 105", "TextBox 106", "TextBox 108", "TextBox 109", "TextBox 110", "TextBox 111", "TextBox 113", "TextBox 114", _
                    "TextBox 116", "TextBox 117", "TextBox 118", "TextBox 119", "TextBox 120", "TextBox 121", "TextBox 122", "TextBox 123", _
                    "TextBox 124", "TextBox 125", "TextBox 127", "TextBox 129", "TextBox 130", "TextBox 131", "TextBox 133", "TextBox 135", _
                    "TextBox 136", "TextBox 137", "TextBox 138", "TextBox 139", "TextBox 140", "TextBox 141", "TextBox 142", "TextBox 144", _
                    "TextBox 146", "TextBox 147", "TextBox 148", "TextBox 150", "TextBox 152", "TextBox 153", "TextBox 155", "TextBox 157", _
                    "TextBox 158", "TextBox 160", "TextBox 161", "TextBox 163", "TextBox 164", "TextBox 165", "TextBox 166", "TextBox 167", _
                    "TextBox 168", "TextBox 169", "TextBox 170", "TextBox 172", "TextBox 173", "TextBox 174", "TextBox 175", "TextBox 176", _
                    "TextBox 177", "TextBox 178", "TextBox 179", "TextBox 180", "TextBox 182", "TextBox 183", "TextBox 185", "TextBox 186", _
                    "TextBox 187", "TextBox 188", "TextBox 189", "TextBox 190", "TextBox 192", "TextBox 193", "TextBox 194", "TextBox 196", _
                    "TextBox 197", "TextBox 198", "TextBox 199", "TextBox 200", "TextBox 201", "TextBox 203", "TextBox 204", "TextBox 205", _
                    "TextBox 206", "TextBox 207", "TextBox 208", "TextBox 209", "TextBox 210", "TextBox 211", "TextBox 212", "TextBox 213", _
                    "TextBox 214", "TextBox 216", "TextBox 217", "TextBox 218", "TextBox 219", "TextBox 220", "TextBox 221", "TextBox 222", _
                    "TextBox 223", "TextBox 224", "TextBox 225", "TextBox 226", "TextBox 227", "TextBox 229", "TextBox 230", "TextBox 231", _
                    "TextBox 232", "TextBox 234", "TextBox 235", "TextBox 236", "TextBox 238", "TextBox 239", "TextBox 240", "TextBox 241", _
                    "TextBox 242", "TextBox 243", "TextBox 245", "TextBox 246", "TextBox 248", "TextBox 249", "TextBox 250", "TextBox 251")
                   
    Set dicStp = CreateObject("Scripting.Dictionary")

    dicStp("1") = RGB(255, 255, 0)
    dicStp("2") = RGB(0, 176, 80)
    dicStp("3") = RGB(255, 153, 255)
    dicStp("4") = RGB(255, 113, 17)
    dicStp("5") = RGB(0, 76, 240)
    dicStp("6") = RGB(204, 0, 255)
    dicStp("7") = RGB(255, 0, 0)
    dicStp("8") = RGB(102, 51, 0)
    dicStp("9") = RGB(191, 191, 191)
    dicStp("10") = RGB(23, 55, 94)

    For idx = UBound(idTextBox) To UBound(idTextBox)

        Txt = Range("B" & idx + 3).Value
        Stp = Range("A3" & idx + 3).Value
        ActiveSheet.Shapes(idTextBox(idx)).TextFrame2.TextRange.Characters.Text = Txt
        ActiveSheet.Shapes.Range(idTextBox(idx)).Select
        With Selection.ShapeRange.Fill
            If Stp = "" Then
                .ForeColor.RGB = RGB(255, 255, 255)
            Else
                .ForeColor.RGB = dicStp(Stp)
            End If
        End With

    For idx = UBound(idTextBox) To UBound(idTextBox)

        Txt = Range("B" & idx + 3).Value
        Stp = Range("A3" & idx + 3).Value
        ActiveSheet.Shapes(idTextBox(idx)).TextFrame2.TextRange.Characters.Text = Txt
        ActiveSheet.Shapes.Range(idTextBox(idx)).Select
        With Selection.ShapeRange.Fill
            If Stp = "" Then
                .ForeColor.RGB = RGB(255, 255, 255)
            Else
                .ForeColor.RGB = dicStp(Stp)
            End If
        End With
Your help has saved me hundreds of hours of internet surfing.
fblack61
Norie

idx is only being used as the loop variable when looping through the array of textbox ids, you shouldn't need to change anything there.

All you should need to do is add all the textbox names to the idTextBox and complete the dictionary with the colours for '3' to '9'.

Is the code you posted not working?

P.S. Why are  you repeating the loop?
Trygve Thayer

ASKER
My interpretation is I need The "For IDX" statement for each of the boxes.  Can you show me what the "Next IDX" statement will look like.   what do I change these to for the next box.  I am going to try to attach the file so you can see what I have so far.  There are 2 macros.  One is called :copy text" and works.  The "copy and Color" is the one I am working on but not sure what the next IDX statement looks like.Load Sheet File.xlsm
Norie

You don't need the for statement for each textbox.

The whole idea is that you have an array with the names of the textboxes you want to run the same code on and you loop through that array and apply that code to each textbox as you loop.

Note there's a type in the code I posted, I've fixed it in the original post but this is how the loop should look.
For idx = LBound(idTextBox) To UBound(idTextBox)

Open in new window


By the way, you've not really given any information regarding the location of your textboxes.

The code I posted assumes all the textboxes named in the array are on the same sheet, but after looking at the uploaded file I'm nto sure that's right.

If that's the case you really need to give us some more information.
Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.
Trygve Thayer

ASKER
Sorry I have not given enough information.  All the text boxes are on the same sheet in column C starting at row 3 and going down to Row 202

My interest is to copy the text from Column B Row 3 and put in the textbox in Column C Row 3.  Then based on the value in the corresponding Column A Row 3 turn the textbox a certain color.  Then I go to Column B Row 4 and put in the textbox in Column C Row 4.  Then based on the value in the corresponding Column A Row 4 turn the textbox a certain color.  etc all the way to row 202


Here is a snippet of what I have done now.
Option Explicit

Sub CopyandColor()
'
' CreateBlocks Macro
' CreateBlocks
Dim dicStp As Object
Dim Txt As String
Dim Stp As String
Dim idx As Long
Dim idTextBox As Variant

    idTextBox = Array("TextBox 3", "TextBox 4", "TextBox 5", "TextBox 7", "TextBox 8", "TextBox 10", "TextBox 12", "TextBox 13", _
                    "TextBox 15", "TextBox 17", "TextBox 18", "TextBox 19", "TextBox 20", "TextBox 21", "TextBox 22", "TextBox 23", _
                    "TextBox 24", "TextBox 25", "TextBox 26", "TextBox 27", "TextBox 28", "TextBox 29", "TextBox 30", "TextBox 31", _
                    "TextBox 32", "TextBox 33", "TextBox 34", "TextBox 36", "TextBox 37", "TextBox 38", "TextBox 40", "TextBox 42", _
                    "TextBox 43", "TextBox 44", "TextBox 45", "TextBox 46", "TextBox 47", "TextBox 48", "TextBox 49", "TextBox 50", _
                    "TextBox 51", "TextBox 52", "TextBox 54", "TextBox 55", "TextBox 57", "TextBox 58", "TextBox 60", "TextBox 61", _
                    "TextBox 62", "TextBox 64", "TextBox 65", "TextBox 67", "TextBox 69", "TextBox 70", "TextBox 71", "TextBox 72", _
                    "TextBox 73", "TextBox 74", "TextBox 76", "TextBox 77", "TextBox 79", "TextBox 81", "TextBox 82", "TextBox 83", _
                    "TextBox 84", "TextBox 86", "TextBox 87", "TextBox 89", "TextBox 90", "TextBox 91", "TextBox 92", "TextBox 93", _
                    "TextBox 95", "TextBox 96", "TextBox 97", "TextBox 98", "TextBox 100", "TextBox 102", "TextBox 103", "TextBox 104", _
                    "TextBox 105", "TextBox 106", "TextBox 108", "TextBox 109", "TextBox 110", "TextBox 111", "TextBox 113", "TextBox 114", _
                    "TextBox 116", "TextBox 117", "TextBox 118", "TextBox 119", "TextBox 120", "TextBox 121", "TextBox 122", "TextBox 123", _
                    "TextBox 124", "TextBox 125", "TextBox 127", "TextBox 129", "TextBox 130", "TextBox 131", "TextBox 133", "TextBox 135", _
                    "TextBox 136", "TextBox 137", "TextBox 138", "TextBox 139", "TextBox 140", "TextBox 141", "TextBox 142", "TextBox 144", _
                    "TextBox 146", "TextBox 147", "TextBox 148", "TextBox 150", "TextBox 152", "TextBox 153", "TextBox 155", "TextBox 157", _
                    "TextBox 158", "TextBox 160", "TextBox 161", "TextBox 163", "TextBox 164", "TextBox 165", "TextBox 166", "TextBox 167", _
                    "TextBox 168", "TextBox 169", "TextBox 170", "TextBox 172", "TextBox 173", "TextBox 174", "TextBox 175", "TextBox 176", _
                    "TextBox 177", "TextBox 178", "TextBox 179", "TextBox 180", "TextBox 182", "TextBox 183", "TextBox 185", "TextBox 186", _
                    "TextBox 187", "TextBox 188", "TextBox 189", "TextBox 190", "TextBox 192", "TextBox 193", "TextBox 194", "TextBox 196", _
                    "TextBox 197", "TextBox 198", "TextBox 199", "TextBox 200", "TextBox 201", "TextBox 203", "TextBox 204", "TextBox 205", _
                    "TextBox 206", "TextBox 207", "TextBox 208", "TextBox 209", "TextBox 210", "TextBox 211", "TextBox 212", "TextBox 213", _
                    "TextBox 214", "TextBox 216", "TextBox 217", "TextBox 218", "TextBox 219", "TextBox 220", "TextBox 221", "TextBox 222", _
                    "TextBox 223", "TextBox 224", "TextBox 225", "TextBox 226", "TextBox 227", "TextBox 229", "TextBox 230", "TextBox 231", _
                    "TextBox 232", "TextBox 234", "TextBox 235", "TextBox 236", "TextBox 238", "TextBox 239", "TextBox 240", "TextBox 241", _
                    "TextBox 242", "TextBox 243", "TextBox 245", "TextBox 246", "TextBox 248", "TextBox 249", "TextBox 250", "TextBox 251")
                    
    Set dicStp = CreateObject("Scripting.Dictionary")

    dicStp("1") = RGB(255, 255, 0)
    dicStp("2") = RGB(0, 176, 80)
    dicStp("3") = RGB(255, 153, 255)
    dicStp("4") = RGB(255, 113, 17)
    dicStp("5") = RGB(0, 76, 240)
    dicStp("6") = RGB(204, 0, 255)
    dicStp("7") = RGB(255, 0, 0)
    dicStp("8") = RGB(102, 51, 0)
    dicStp("9") = RGB(191, 191, 191)
    dicStp("10") = RGB(23, 55, 94)

    For idx = LBound(idTextBox) To UBound(idTextBox)

        Txt = Range("B3" & idx + 3).Value
        Stp = Range("A3" & idx + 3).Value
        ActiveSheet.Shapes(idTextBox(idx)).TextFrame2.TextRange.Characters.Text = Txt
        ActiveSheet.Shapes.Range(idTextBox(idx)).Select
        With Selection.ShapeRange.Fill
            If Stp = "" Then
                .ForeColor.RGB = RGB(255, 255, 255)
            Else
                .ForeColor.RGB = dicStp(Stp)
            End If
        End With

    Next
     
        Txt = Range("B4" & idx + 3).Value
        Stp = Range("A4" & idx + 3).Value
        ActiveSheet.Shapes(idTextBox(idx)).TextFrame2.TextRange.Characters.Text = Txt
        ActiveSheet.Shapes.Range(idTextBox(idx)).Select
        With Selection.ShapeRange.Fill
            If Stp = "" Then
                .ForeColor.RGB = RGB(255, 255, 255)
            Else
                .ForeColor.RGB = dicStp(Stp)
            End If
        End With
    
    Next
        Txt = Range("B5" & idx + 3).Value
        Stp = Range("A5" & idx + 3).Value
        ActiveSheet.Shapes(idTextBox(idx)).TextFrame2.TextRange.Characters.Text = Txt
        ActiveSheet.Shapes.Range(idTextBox(idx)).Select
        With Selection.ShapeRange.Fill
            If Stp = "" Then
                .ForeColor.RGB = RGB(255, 255, 255)
            Else
                .ForeColor.RGB = dicStp(Stp)
            End If
        End With
        
    Next
        Txt = Range("B6").Value
        Stp = Range("A6").Value
        ActiveSheet.Shapes(idTextBox(idx)).TextFrame2.TextRange.Characters.Text = Txt
        ActiveSheet.Shapes.Range(idTextBox(idx)).Select
        With Selection.ShapeRange.Fill
            If Stp = "" Then
                .ForeColor.RGB = RGB(255, 255, 255)
            Else
                .ForeColor.RGB = dicStp(Stp)
            End If
        End With
        
    Next
        Txt = Range("B7").Value
        Stp = Range("A7").Value
        ActiveSheet.Shapes(idTextBox(idx)).TextFrame2.TextRange.Characters.Text = Txt
        ActiveSheet.Shapes.Range(idTextBox(idx)).Select
        With Selection.ShapeRange.Fill
            If Stp = "" Then
                .ForeColor.RGB = RGB(255, 255, 255)
            Else
                .ForeColor.RGB = dicStp(Stp)
            End If
        End With
        
    Next
        Txt = Range("B8").Value
        Stp = Range("A8").Value
        ActiveSheet.Shapes(idTextBox(idx)).TextFrame2.TextRange.Characters.Text = Txt
        ActiveSheet.Shapes.Range(idTextBox(idx)).Select
        With Selection.ShapeRange.Fill
            If Stp = "" Then
                .ForeColor.RGB = RGB(255, 255, 255)
            Else
                .ForeColor.RGB = dicStp(Stp)
            End If
        End With
        
    Next
        Txt = Range("B9").Value
        Stp = Range("A9").Value
        ActiveSheet.Shapes(idTextBox(idx)).TextFrame2.TextRange.Characters.Text = Txt
        ActiveSheet.Shapes.Range(idTextBox(idx)).Select
        With Selection.ShapeRange.Fill
            If Stp = "" Then
                .ForeColor.RGB = RGB(255, 255, 255)
            Else
                .ForeColor.RGB = dicStp(Stp)
            End If
        End With
        
    Next
        Txt = Range("B10").Value
        Stp = Range("A10").Value
        ActiveSheet.Shapes(idTextBox(idx)).TextFrame2.TextRange.Characters.Text = Txt
        ActiveSheet.Shapes.Range(idTextBox(idx)).Select
        With Selection.ShapeRange.Fill
            If Stp = "" Then
                .ForeColor.RGB = RGB(255, 255, 255)
            Else
                .ForeColor.RGB = dicStp(Stp)
            End If
        End With
               
    Next
        Txt = Range("B11").Value
        Stp = Range("A11").Value
        ActiveSheet.Shapes(idTextBox(idx)).TextFrame2.TextRange.Characters.Text = Txt
        ActiveSheet.Shapes.Range(idTextBox(idx)).Select
        With Selection.ShapeRange.Fill
            If Stp = "" Then
                .ForeColor.RGB = RGB(255, 255, 255)
            Else
                .ForeColor.RGB = dicStp(Stp)
            End If
        End With
        
    Next
        Txt = Range("B12").Value
        Stp = Range("A12").Value
        ActiveSheet.Shapes(idTextBox(idx)).TextFrame2.TextRange.Characters.Text = Txt
        ActiveSheet.Shapes.Range(idTextBox(idx)).Select
        With Selection.ShapeRange.Fill
            If Stp = "" Then
                .ForeColor.RGB = RGB(255, 255, 255)
            Else
                .ForeColor.RGB = dicStp(Stp)
            End If
        End With
        
    

End Sub

Open in new window

ASKER CERTIFIED SOLUTION
Norie

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question
Trygve Thayer

ASKER
This worked perfectly.  I still don't understand how the code works but it does.  Thanks so much !!!!