Compacting Verbose Script

[N8theGreat]

I have a simple conversion script below that converts pressure from psi to kpa and flow from gpm to lpm. It is triggered from a shape I linked to the macro Toggle_Clickwtext(). This code is very long winded, but gets the job done. In an effort to sharpen my skills and create better and more compact code in future, how could this be done shorter and better?

Sub Toggle_ClickwText()
Application.ScreenUpdating = False
'Toggles from Blue to Green for data units
Dim Shp As Shape 'creates a memory allocation for the shape
Dim ToggleValue As Boolean 'give the shape one of two possible values
Set Shp = ActiveSheet.Shapes(Application.Caller) 'tells excel that the shape will change values
    With Shp 'activates the shape and opens the possibility of changing the peripheral values
        If .Fill.ForeColor.RGB = RGB(80, 80, 255) Then 'is the color blue?
             .Fill.ForeColor.RGB = RGB(80, 210, 130) 'if so, make it green
             .TextEffect.Text = "Metric" 'also change the text to "metric"
             Call UStoMetric 'Call the script called "UStoMetric" above
        Else 'or
             .Fill.ForeColor.RGB = RGB(80, 80, 255) 'make the shape blue
             .TextEffect.Text = "US Units" 'change the text
             Call MetrictoUS 'and Call the "MetrictoUs" script above
        End If
    End With
End Sub
Sub UStoMetric()
Application.ScreenUpdating = False
Dim U(27, 1) 'create an array 27 rows by 1 column
    v = 1
    For t = 29 To 54 'give t limitations with the for/next functions
    U(v, 1) = Cells(t, 7) 'save the current pressure values into the array
    v = v + 1 'advance
    Next t 'advance to next t value in the for/next loop
    
    v = 1 'reset v value
    For t = 29 To 54 'reset t limitations
    Cells(t, 7) = (U(v, 1)) * 6.89475729 'calculation to convert to kpa
    v = v + 1 'advance
    Next t 'advance to next t value in the for/next loop
    
Dim MM(26, 2) 'create array of 26 rows and 2 columns
p = 1
q = 1
    For s = 8 To 9 'set limitations for the "s" for/next loop
        For r = 29 To 54 'nest the second for/next loop and set limitations
        MM(p, q) = Cells(r, s) 'save the pressure data values into the MM array
        p = p + 1 'advance to next value
        Next r 'advance to next value in the r for/next loop
        r = 29 'reset the r value when the r for/next loop is complete
        p = 1 'reset p value
    q = q + 1 'advance q value
    Next s 'advance to the next value in the s loop
    
p = 1 'reset p value
q = 1 'reset q value
For s = 8 To 9 'set value s for/next loop
    For r = 29 To 54 'nest r loop and set limitations
    Cells(r, s) = Application.WorksheetFunction.Convert(MM(p, q), "gal", "l") 'use the convert function to
        'use the values in the array function and use the convert function to rewrite the data back into the form
    p = p + 1 'advance in the MM array
    Next r 'advance to the next step in the r for/next loop
    r = 29 'reset r value
    p = 1 ' reset p value
q = q + 1 'advance q value
Next
Cells(27, 7) = "(kpa)"
Cells(27, 8) = "(lpm)"
Cells(27, 9) = "(lpm)"
Cells(27, 10) = "(lpm)"
End Sub
'all of the functions below are a mirror of the functions above converting back to metric
Sub MetrictoUS()
Application.ScreenUpdating = False
    Dim X(27, 1)
    v = 1
    For t = 29 To 54
    X(v, 1) = Cells(t, 7)
    v = v + 1
    Next t
    
    v = 1
    For t = 29 To 54
    Cells(t, 7) = (X(v, 1)) / 6.89475729
    v = v + 1
    Next t
    
    Dim MM(26, 2)
p = 1
q = 1
    For s = 8 To 9
        For r = 29 To 54
        MM(p, q) = Cells(r, s)
        p = p + 1
        Next r
        r = 29
        p = 1
    q = q + 1
    Next s
    
p = 1
q = 1
For s = 8 To 9
    For r = 29 To 54
    Cells(r, s) = Application.WorksheetFunction.Convert(MM(p, q), "l", "gal")
    p = p + 1
    Next r
    r = 29
    p = 1
q = q + 1
Next
Cells(27, 7) = "psi"
Cells(27, 8) = "gpm"
Cells(27, 9) = "gpm"
Cells(27, 10) = "gpm"
End Sub

 

[ChrisM]

Have you specified Option Base 1 at the top of your code? If not, then

Dim U(27, 1) 'create an array 27 rows by 1 column

This is not true, this is actually U(O to 27, 0 to 1), so you have 28 rows by 2 columns.

You don't need a two dimensional array anyways, 1-D is fine, so just

Dim U(1 to 27)

Looking at this whole block of code:

v = 1
    For t = 29 To 54 'give t limitations with the for/next functions
    U(v, 1) = Cells(t, 7) 'save the current pressure values into the array
    v = v + 1 'advance
    Next t 'advance to next t value in the for/next loop
    
    v = 1 'reset v value
    For t = 29 To 54 'reset t limitations
    Cells(t, 7) = (U(v, 1)) * 6.89475729 'calculation to convert to kpa
    v = v + 1 'advance
    Next t 'advance to next t value in the for/next loop

It seems like all you are doing is multiplying every value by 6.89. There is no need to write to/from an array to do this, you can just use the built in paste-special commands. Several ways to do this, one would be to write 6.89xxx to a hidden part of your workbook (say sheet1, cell D1), then run this code:

Sheet1.Range("D1").Copy

Sheet1.Range("G29:G54").PasteSpecial xlPasteValues, xlPasteSpecialOperationMultiply

 

[N8theGreat]

Chris,

Thanks for the reply. I didn't know of the Option Base statement, and in the process learned of the LBound and UBound functions. Thanks for the heads up on the paste function, that will be handy in the future. I was looking to compact, or eliminate, my For/Next loops using other methods. Any other input would be great.