VBA Error Message

[siva]

I get error message when I run my code.
"Compile error: Procedure too large"
Try to use Loops but not succeeded.
Someone can help!

[Bob Phillips]

There is only si muchg code you can put in one procedure.

You could break it down into related blocks and put those in separate procedures, but your module would still probably be too big, so you would need to split into separate modules.

Untested, but try this



Dim W As String

Private Sub Update_Click()
Dim i As Long

For i = 1 To 14
Call ProcessShape(ThisShape:=Me.Shapes("B" & i & "_"), _
ThisCell:=Sheets("Data").Range("B" & i + 2), _
RelatedCell:=Sheets("Data").Range("J" & i + 2))
Next i

For i = 3 To 12
Call ProcessShape(ThisShape:=Me.Shapes("H" & i & "_"), _
ThisCell:=Sheets("Data").Range("B" & i + 14), _
RelatedCell:=Sheets("Data").Range("J" & i + 14))
Next i

For i = 1 To 14
Call ProcessShape(ThisShape:=Me.Shapes("L" & i & "_"), _
ThisCell:=Sheets("Data").Range("B" & i + 26), _
RelatedCell:=Sheets("Data").Range("J" & i + 26))
Next i

For i = 1 To 14
Call ProcessShape(ThisShape:=Me.Shapes("U" & i & "_"), _
ThisCell:=Sheets("Data").Range("B" & i + 40), _
RelatedCell:=Sheets("Data").Range("J" & i + 40))
Next i

For i = 2 To 14
Call ProcessShape(ThisShape:=Me.Shapes("M" & i & "_"), _
ThisCell:=Sheets("Data").Range("B" & i + 53), _
RelatedCell:=Sheets("Data").Range("J" & i + 53))
Next i

For i = 5 To 12
Call ProcessShape(ThisShape:=Me.Shapes("N" & i & "_"), _
ThisCell:=Sheets("Data").Range("B" & i + 63), _
RelatedCell:=Sheets("Data").Range("J" & i + 63))
Next i

Call ProcessShape(ThisShape:=Me.Shapes("WH_"), _
ThisCell:=Sheets("Data").Range("B76"), _
RelatedCell:=Sheets("Data").Range("J76"))

Call ProcessShape(ThisShape:=Me.Shapes("FN_"), _
ThisCell:=Sheets("Data").Range("B77"), _
RelatedCell:=Sheets("Data").Range("J77"))
End Sub

Private Sub ProcessShape(ByRef ThisShape As Shape, _
ByRef ThisCell As Range, _
ByRef RelatedCell As Range)

With ThisShape.Fill.ForeColor
Select Case ThisCell.Value
Case 0.01 To 0.28: .SchemeColor = 2 'RED
Case 0.29 To 0.3: .SchemeColor = 53
Case 0.31 To 0.5: .SchemeColor = 52
Case 0.51 To 0.9: .SchemeColor = 51
Case 0.91 To 1: .SchemeColor = 17
Case Else: .SchemeColor = 1
End Select
End With
If RelatedCell.Value = "W" Then
With ThisShape
.Line.ForeColor
.Line.Weight = 2.5
.Line.DashStyle = msoLineDash
.Line.Style = msoLineSingle
.Line.Visible = msoTrue
.Line.ForeColor.SchemeColor = 12
End With
Else
With ThisShape.Line
.ForeColor
.Weight = 3
.DashStyle = msoLineSolid
.Style = msoLineSingle
.Visible = msoTrue
.ForeColor.SchemeColor = 64
End With
End If
End Sub

[siva]

I got the following error.

---------------------------
Microsoft Visual Basic
---------------------------
Compile error:

Invalid use of property
---------------------------
OK Help
---------------------------

Private Sub ProcessShape(ByRef ThisShape As Shape, _
ByRef ThisCell As Range, _
ByRef RelatedCell As Range)

With ThisShape.Fill.ForeColor
Select Case ThisCell.Value
Case 0.01 To 0.28: .SchemeColor = 2 'RED
Case 0.29 To 0.3: .SchemeColor = 53
Case 0.31 To 0.5: .SchemeColor = 52
Case 0.51 To 0.9: .SchemeColor = 51
Case 0.91 To 1: .SchemeColor = 17
Case Else: .SchemeColor = 1
End Select
End With
If RelatedCell.Value = "W" Then
With ThisShape
.Line.ForeColor

[Bob Phillips]

My mistake



Option Explicit

Dim W As String

Private Sub Update_Click()
Dim i As Long

For i = 1 To 14
Call ProcessShape(ThisShape:=Me.Shapes("B" & i & "_"), _
ThisCell:=Sheets("Data").Range("B" & i + 2), _
RelatedCell:=Sheets("Data").Range("J" & i + 2))
Next i

For i = 3 To 12
Call ProcessShape(ThisShape:=Me.Shapes("H" & i & "_"), _
ThisCell:=Sheets("Data").Range("B" & i + 14), _
RelatedCell:=Sheets("Data").Range("J" & i + 14))
Next i

For i = 1 To 14
Call ProcessShape(ThisShape:=Me.Shapes("L" & i & "_"), _
ThisCell:=Sheets("Data").Range("B" & i + 26), _
RelatedCell:=Sheets("Data").Range("J" & i + 26))
Next i

For i = 1 To 14
Call ProcessShape(ThisShape:=Me.Shapes("U" & i & "_"), _
ThisCell:=Sheets("Data").Range("B" & i + 40), _
RelatedCell:=Sheets("Data").Range("J" & i + 40))
Next i

For i = 2 To 14
Call ProcessShape(ThisShape:=Me.Shapes("M" & i & "_"), _
ThisCell:=Sheets("Data").Range("B" & i + 53), _
RelatedCell:=Sheets("Data").Range("J" & i + 53))
Next i

For i = 5 To 12
Call ProcessShape(ThisShape:=Me.Shapes("N" & i & "_"), _
ThisCell:=Sheets("Data").Range("B" & i + 63), _
RelatedCell:=Sheets("Data").Range("J" & i + 63))
Next i

Call ProcessShape(ThisShape:=Me.Shapes("WH_"), _
ThisCell:=Sheets("Data").Range("B76"), _
RelatedCell:=Sheets("Data").Range("J76"))

Call ProcessShape(ThisShape:=Me.Shapes("FN_"), _
ThisCell:=Sheets("Data").Range("B77"), _
RelatedCell:=Sheets("Data").Range("J77"))
End Sub

Private Sub ProcessShape(ByRef ThisShape As Shape, _
ByRef ThisCell As Range, _
ByRef RelatedCell As Range)

With ThisShape.Fill.ForeColor
Select Case ThisCell.Value
Case 0.01 To 0.28: .SchemeColor = 2 'RED
Case 0.29 To 0.3: .SchemeColor = 53
Case 0.31 To 0.5: .SchemeColor = 52
Case 0.51 To 0.9: .SchemeColor = 51
Case 0.91 To 1: .SchemeColor = 17
Case Else: .SchemeColor = 1
End Select
End With
If RelatedCell.Value = "W" Then
With ThisShape.Line
.Weight = 2.5
.DashStyle = msoLineDash
.Style = msoLineSingle
.Visible = msoTrue
.ForeColor.SchemeColor = 12
End With
Else
With ThisShape.Line
.Weight = 3
.DashStyle = msoLineSolid
.Style = msoLineSingle
.Visible = msoTrue
.ForeColor.SchemeColor = 64
End With
End If
End Sub

[siva]

Dear XLD,
I manage to clear the error message by editing as follow
If RelatedCell.Value = "W" Then
With ThisShape.Line.ForeColor
ThisShape.Line.Weight = 2.5
ThisShape.Line.DashStyle = msoLineDash
ThisShape.Line.Style = msoLineSingle
ThisShape.Line.Visible = msoTrue
ThisShape.Line.ForeColor.SchemeColor = 12
End With
Else
With ThisShape.Line.ForeColor
ThisShape.Line.Weight = 3
ThisShape.Line.DashStyle = msoLineSolid
ThisShape.Line.Style = msoLineSingle
ThisShape.Line.Visible = msoTrue
ThisShape.Line.ForeColor.SchemeColor = 64

Thank you verymuch.:friends:.

[Bob Phillips]

You've done too much, see my code in the previous post.

[siva]

Dear XLD,
the "fill colour" does not change for shape B13 & B14 (cell A15 & A16).

[Bob Phillips]

Post your new amende workbook.

[siva]

Dear XLD,
As requested.