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"
精彩评论