Thread: shorten a macro
View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Susan Susan is offline
external usenet poster
 
Posts: 1,117
Default shorten a macro

hi axel
for this, i think you need a case statement - will still be long, but
will be shorter than all the if-then's......

like this:
dim iCtr as integer
dim myBox as control
dim myRange as range
dim ws as worksheet

set ws = activeworkbook.worksheets("5 7 7hwdp")
set myBox = me.Textbox1
iCtr = ComboBox1.Value

Select Case [iCtr]
Case Is = 1
Set myBox.text = ws.Range("B4")
Case Is = 2
Set myRange = ws.Range("B5")
Case Is = 3
Set myRange = ws.Range("B6")
Case Is = 4
Set myRange = ws.Range("B7")
'etc...........
Case Else
'Error or Else Condition
MsgBox "I can't find the case range!"
End Select



Private Sub ComboBox1_Change()
'shows the row number to the serialnumber
If ComboBox1.Value = 1 Then
'shows the serialnumber
TextBox1.Text = Range("B4")
Else
If ComboBox1.Value = 2 Then
TextBox1.Text = Range("B5")
Else
If ComboBox1.Value = 3 Then
TextBox1.Text = Range("B6")
Else
End If
End If
End If
End Sub


that's that section.
for the click(), you could also use the same case statement you
already set above...........
and i would shorten up the TextBox2 codings by using a with-end with:

If iCtr = 1 then
with Textbox2 'notice the dots!
.SelStart = 0
.SelLength = .TextLength
.Copy
end with
myRange.paste
elseif iCtr = 2 then
with Textbox2 'notice the dots!
.SelStart = 0
.SelLength = .TextLength
.Copy
end with
myRange.paste
elseif iCtr = 3 then
with Textbox2 'notice the dots!
.SelStart = 0
.SelLength = .TextLength
.Copy
end with
myRange.paste
end if
'you could leave
TextBox2.Text = ""
'till the end

you could shorten up the selstart & sellength business, too, since
you're doing it over & over again.

i would probably make a little extra sub, maybe called
sub txtbox_changes()
with Textbox2 'notice the dots!
.SelStart = 0
.SelLength = .TextLength
.Copy
.Text = ""
end with
end sub

and then change these to:

If iCtr = 1 then
call txtbox_changes
myRange.paste
elseif......... blah blah
call txtbox_changes
blah blah
elseif ......... blah blah
call txtbox_changes
blah blah
end if

just ideas
:)
susan



Private Sub CommandButton1_Click()
ActiveSheet.Unprotect Password:="driller"
Application.ScreenUpdating = False
'shows the row number to the serialnumber
If ComboBox1.Value = 1 Then
TextBox2.SelStart = 0
TextBox2.SelLength = TextBox2.TextLength
TextBox2.Copy
ActiveSheet.Paste Destination:=Worksheets("5 7.8hwdp").Range("B4")
TextBox2.Text = ""
Else
If ComboBox1.Value = 2 Then
TextBox2.SelStart = 0
TextBox2.SelLength = TextBox2.TextLength
TextBox2.Copy
ActiveSheet.Paste Destination:=Worksheets("5 7.8hwdp").Range("B5")
TextBox2.Text = ""
Else
If ComboBox1.Value = 3 Then
TextBox2.SelStart = 0
TextBox2.SelLength = TextBox2.TextLength
TextBox2.Copy
ActiveSheet.Paste Destination:=Worksheets("5 7.8hwdp").Range("B6")
TextBox2.Text = ""
Else
End If
End If
End If



ActiveSheet.Protect Password:="driller", DrawingObjects:=True,
Contents:=True, Scenarios:=True
Unload ShngSrlNbrUsrFrm
End Sub

gratful for all help
Aksel

*** Sent via Developersdexhttp://www.developersdex.com***