shorten a macro

[Axel]

Hi!
Anyone who can help me to shorten two macros. both is in the same
Userform.
Userform has:
one combobox
two textbox
comandbutton


The first code is a combobox that has rowsource A4:46, that is the count
number for the items in the sheet. and it's a textbox that show the
serialnumber to the item in that column B4:B46.

The second macro is bound to a button on the userform, and change the
serialnumber to the item that is choosed in textbox1, with what is
written in textbox2.

Here is the first 3 off 46
as u can see, its going to be a large code

'This macro show the old serialnumber in an textbox, just to verify
'that the user choose the right item

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


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 Developersdex http://www.developersdex.com ***

 

[Susan]

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

 

[Axel]

Hi Susan!
Thank you for the time you use to help me.
It's bedtime up north now, but I looking forward to try your code
tomorrow
Again Thanks!

*** Sent via Developersdex http://www.developersdex.com ***