Stephan
Member
XL UK HeatMap attached looks & works great.
But VB 1st Module macro1, can this be more concise?
But VB 1st Module macro1, can this be more concise?
Code:
Sub Edit1()
Sheets("Dash").Select
Application.ScreenUpdating = False
Dim Sub13 As Integer
Dim Sub21 As Integer
Dim Sub19 As Boolean
Dim Sub16111 As Integer
'just a little scrable
Dim Sub12 As Integer
Dim Sub24 As String
Dim Sub20 As Variant
Dim Sub15 As Integer
Dim Sub17 As String
Dim Sub16 As Integer
Dim Sub18 As Double
Dim Sub23 As Integer
Dim Sub14 As Integer
Dim i As Integer
Dim iTotal As Integer
Sub19 = False
Sub23 = Sub13
Sub12 = 1
Sub14 = 16
Sub13 = 15
Sub20 = Range("data").Value
Sub16 = Sub12 + (Sub13 / Sub12)
Dim Sub22 As String
Sub21 = Sub16
For Sub15 = Sub12 To UBound(Sub20)
Sub17 = Sub20(Sub15, Sub12)
Sub18 = Sub20(Sub15, Sub12 + Sub14 - Sub13)
If (Sub19 = False Or Sub17 = "DASH") Then
Edit2 Sub17, Sub18
Else
On Error Resume Next
ActiveSheet.Shapes("S_" & Sub17).Delete
On Error GoTo 0
End If
Next Sub15
DoEvents
Application.ScreenUpdating = False
DoEvents
For Sub15 = Sub12 To Sub16
Range("scale" & Sub15).Interior.color = Range("color" & Sub15).Interior.color
Next Sub15
i = Sub12 + Sub12 + Sub12
iTotal = Sub14 - Sub13
Do While i > 5 * (Sub14 - Sub13)
iTotal = i + iTotal
i = i - Sub12
Loop
End Sub
Sub Edit2(Sub6 As String, Sub9 As Double)
Dim Sub7 As Integer
Dim Sub5 As Long
Dim Sub11 As String
Dim Sub10
Dim Sub8 As Variant
Application.ScreenUpdating = False
Sub8 = Range("scales").Value
For Sub7 = UBound(Sub8) To 1 Step -1
If (Sub9 >= Sub8(Sub7, 1) Or Sub7 = 1) Then
Sub5 = Range("color" & Sub7).Interior.color
Sub7 = -1
End If
Next Sub7
Edit3 "S_" & Sub6, Sub5
Application.ScreenUpdating = False
End Sub
Sub Edit3(Sub1 As String, Sub4 As Long)
Dim Sub2 As Double
Dim Sub3 As Double
Application.ScreenUpdating = False
On Error GoTo ending
ActiveSheet.Shapes(Sub1).Select
Application.ScreenUpdating = False
Sub3 = Range("transparency").Value / 100
ActiveSheet.Shapes(Sub1).Fill.Solid
ActiveSheet.Shapes(Sub1).Fill.ForeColor.RGB = Sub4
ActiveSheet.Shapes(Sub1).Fill.transparency = Sub3
ActiveSheet.Shapes(Sub1).Fill.Visible = msoTrue
Sub2 = 1
If (Sub2 > 0#) Then
ActiveSheet.Shapes(Sub1).Line.Weight = Sub2
ActiveSheet.Shapes(Sub1).Line.DashStyle = msoLineSolid
ActiveSheet.Shapes(Sub1).Line.Style = msoLineSingle
ActiveSheet.Shapes(Sub1).Line.ForeColor.RGB = RGB(75, 75, 75)
ActiveSheet.Shapes(Sub1).Line.Visible = msoTrue
Else
ActiveSheet.Shapes(Sub1).Line.Visible = msoFalse
End If
ending:
End Sub
Sub Edit4()
Application.ScreenUpdating = False
End Sub