ExcelBanter - shortening a macro

ExcelBanter (https://www.excelbanter.com/)

- Excel Programming (https://www.excelbanter.com/excel-programming/)

- - shortening a macro (https://www.excelbanter.com/excel-programming/330864-shortening-macro.html)

shortening a macro

Anyone who can help me write the macro below a little shorter.
MVH Aksel

Private Sub ComboBox1_Change()
Application.ScreenUpdating = False
Sheets("Sheet1").Unprotect
If ComboBox1.Value = "NONE" Then
With Me.Range("K8")
.FormulaR1C1 = ""
With Me.Range("M8")
.FormulaR1C1 = ""
End With
End With
Else
If ComboBox1.Value = "2 7/8'" Then
With Me.Range("K8")
.FormulaR1C1 = "0,0145"
With Me.Range("M8")
.FormulaR1C1 = "0,0123"
End With
End With
Else
If ComboBox1.Value = "4'" Then
With Me.Range("K8")
.FormulaR1C1 = "0,0348"
With Me.Range("M8")
.FormulaR1C1 = "0,0177"
End With
End With
Else
If ComboBox1.Value = "5 7/8'" Then
With Me.Range("K8")
.FormulaR1C1 = "0,0839"
With Me.Range("M8")
.FormulaR1C1 = "0,0298"
End With
End With
Else
If ComboBox1.Value = "4'HW" Then
With Me.Range("K8")
.FormulaR1C1 = "0,0209"
With Me.Range("M8")
.FormulaR1C1 = "0,0333"
End With
End With
Else
If ComboBox1.Value = "5 7/8'HW" Then
With Me.Range("K8")
.FormulaR1C1 = "0,051"
With Me.Range("M8")
.FormulaR1C1 = "0,0686"
End With
End With
Else
If ComboBox1.Value = "DC" Then
With Me.Range("K8")
.FormulaR1C1 = ""
With Me.Range("M8")
.FormulaR1C1 = ""
End With
End With
Else
If ComboBox1.Value = "6 3/4'DC" Then
With Me.Range("K8")
.FormulaR1C1 = "0,0252"
With Me.Range("M8")
.FormulaR1C1 = "0,0948"
End With
End With
Else
If ComboBox1.Value = "8'DC" Then
With Me.Range("K8")
.FormulaR1C1 = ""
With Me.Range("M8")
.FormulaR1C1 = ""
End With
End With
Else
If ComboBox1.Value = "8 1/4'DC" Then
With Me.Range("K8")
.FormulaR1C1 = "0,0287"
With Me.Range("M8")
.FormulaR1C1 = "0,1596"
End With
End With
Else
If ComboBox1.Value = "8 3/4'DC" Then
With Me.Range("K8")
.FormulaR1C1 = ""
With Me.Range("M8")
.FormulaR1C1 = ""
End With
End With
Else
If ComboBox1.Value = "9 3/4'DC" Then
With Me.Range("K8")
.FormulaR1C1 = "0,2456"
With Me.Range("M8")
.FormulaR1C1 = "0,2743"
End With
End With
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
With Me.Range("J24")

End With
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

shortening a macro

"Aksel Børve" wrote in message
...
Anyone who can help me write the macro below a little shorter.
MVH Aksel

how bout this:

Private Sub ComboBox1_Change()
Application.ScreenUpdating = False
Sheets("Sheet1").Unprotect

dim cboval
cboval = ComboBox1.Value

select case cboval

case "none"
range("K8") = "NONE"
Range("M8") = ""

case "2 7/8'"
Range("K8") = "0,0145"
Range("M8") = "0,0123"

etc etc etc etc etc for all cases even...

case else
msgbox "dun fit any defined criteria, try again dude"

end select

end sub

If ComboBox1.Value = "NONE" Then
With Me.Range("K8")
.FormulaR1C1 = ""
With Me.Range("M8")
.FormulaR1C1 = ""
End With
End With
Else
If ComboBox1.Value = "2 7/8'" Then
With Me.Range("K8")
.FormulaR1C1 = "0,0145"
With Me.Range("M8")
.FormulaR1C1 = "0,0123"
End With
End With
Else
If ComboBox1.Value = "4'" Then
With Me.Range("K8")
.FormulaR1C1 = "0,0348"
With Me.Range("M8")
.FormulaR1C1 = "0,0177"
End With
End With
Else
If ComboBox1.Value = "5 7/8'" Then
With Me.Range("K8")
.FormulaR1C1 = "0,0839"
With Me.Range("M8")
.FormulaR1C1 = "0,0298"
End With
End With
Else
If ComboBox1.Value = "4'HW" Then
With Me.Range("K8")
.FormulaR1C1 = "0,0209"
With Me.Range("M8")
.FormulaR1C1 = "0,0333"
End With
End With
Else
If ComboBox1.Value = "5 7/8'HW" Then
With Me.Range("K8")
.FormulaR1C1 = "0,051"
With Me.Range("M8")
.FormulaR1C1 = "0,0686"
End With
End With
Else
If ComboBox1.Value = "DC" Then
With Me.Range("K8")
.FormulaR1C1 = ""
With Me.Range("M8")
.FormulaR1C1 = ""
End With
End With
Else
If ComboBox1.Value = "6 3/4'DC" Then
With Me.Range("K8")
.FormulaR1C1 = "0,0252"
With Me.Range("M8")
.FormulaR1C1 = "0,0948"
End With
End With
Else
If ComboBox1.Value = "8'DC" Then
With Me.Range("K8")
.FormulaR1C1 = ""
With Me.Range("M8")
.FormulaR1C1 = ""
End With
End With
Else
If ComboBox1.Value = "8 1/4'DC" Then
With Me.Range("K8")
.FormulaR1C1 = "0,0287"
With Me.Range("M8")
.FormulaR1C1 = "0,1596"
End With
End With
Else
If ComboBox1.Value = "8 3/4'DC" Then
With Me.Range("K8")
.FormulaR1C1 = ""
With Me.Range("M8")
.FormulaR1C1 = ""
End With
End With
Else
If ComboBox1.Value = "9 3/4'DC" Then
With Me.Range("K8")
.FormulaR1C1 = "0,2456"
With Me.Range("M8")
.FormulaR1C1 = "0,2743"
End With
End With
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
With Me.Range("J24")

End With
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

shortening a macro

For something this long I would probably go with a loop instead. I am
assuming that the combo box is embedded in the worksheet. As such, you likely
set its ListFillRange property to a worksheet range containing the combo box
(CB) list values.

What I would do is:
1) Name a worksheet "Settings".
2) Put the CB ListFillRange values on the hidden sheet in range A1:A12.
3) Put the cell K8 values immediately adjacent in range B1:B12.
4) Put the cell M8 values in range C1:C12.
5) Set the CB ListFillRange property to "Settings!A1:A12".
6) Hide sheet "Settings"
7) Paste the following code to the worksheet code module. The code assumes
that the name of your worksheet is "Data". Change to suit.

Private Sub ComboBox1_Change()
Dim rng As Range
Dim ws1 As Worksheet, ws2 As Worksheet
Dim i As Integer
Set ws1 = Sheets("Settings")
Set ws2 = Sheets("Data")
Set rng = ws1.Range(ws1.Range("A1"), ws1.Range("A1").End(xlDown))
For i = 1 To rng.Count
If ComboBox1.Value = rng(i) Then
ws2.Range("K8") = rng(i, 2)
ws2.Range("M8") = rng(i, 3)
Exit For
End If
Next
End Sub

Note: For future reference, in addition to the Select Case construct, you
should investigate the use of the If/ElseIf/Else/End If constuct. You could
have eliminated all that nesting. Select case is more concise but is more
limited in scope than this method.

Regards,
Greg