procedural vba too long, would like to turn into a function

I have created a VBA script that detects a number and shows a colour based on the range I have given. However, im at a loss as to how to turn this into a function. The problem is that if I repeat this code over and over, i get an error saying stored procedure is too big. Any ideas how to turn this code into a function?

The Q3:Q3 is variable, next lines of code will be R3:R3

The _BAL1 is also variable, varying the 1 on the next lines of code

I am also using this:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("Q3:Q3")) Is Nothing Then
        Me.Shapes("_BAL1").Select
        With Range("BAL1")
                Selection.ShapeRange.Fill.ForeColor.RGB = ThisWorkbook.Colors(.Value)
            .Select
        End With
    End If

Trying to make the code given in the answer work, but it wont work, keeps giving me object 424 error:

Here is the adapted code

Function my_test(ByRef Target As Range, ByVal my_range As String, ByVal my_range2 As String)
  If Not Intersect(Target, Range(my_range)) Is Nothing Then
   Me.Shapes("_" & my_range2).Select
   With Range(my_range2)
      Selection.ShapeRange.Fill.ForeColor.RGB = ThisWorkbook.Colors(.Value).Select
   End With
  End If

End Function


Private Sub Worksheet_Change(ByVal Target As Range)

Call my_test(Target, "Q3:Q3", "BAL1")
Call my_test(Target, "Q4:Q4", "BAL2")

End Sub

Would love to know why the error is there

Function my_test(ByRef Target As Range, ByVal my_range As String, _
                                        ByVal my_range2 As String)   

        If Not Intersect(Target, Range(my_range)) Is Nothing Then 
          Me.Shapes("_" & my_range2).Fill.ForeColor.RGB = _
                   ThisWorkbook.Colors(Range(my_range2).Value)    
        End If

End Function 

Caveat: there's no error checking to catch a non-existent shape of the given name. And you don't need to use Call or parens to call this:

my_test Target, "Q3:Q3", "BAL1"