i need help in splitting a procedure

G

GregJG

I have an add button on a form, that when clicked has the followin
procedure.

Private Sub cmdAdd_Click()

Dim myval1 As Integer
Dim myval2 As Integer

If labT01.Caption = "" Then

labT01.Caption = txtTrip.Value
labEDWA01.Caption = txtWA.Value
labEDFlr01.Caption = txtFlr.Value
labEDHght01.Caption = txtHght.Value
labEDMat01.Caption = txtMat.Value
labEDSF01.Caption = txtSF.Value
labEDNotes01.Caption = txtNotes.Value
myval1 = labEDHght01.Caption
myval2 = labEDFlr01.Caption
labMCPSF01.Caption
Format(Application.WorksheetFunction.VLookup(labEDMat01.Caption
Workbooks("bidditdb.xls").Sheets("mat").Range("a1:j200"), 10, False)
"0.00")
labMCT01.Caption = Format(labMCPSF01.Caption * labEDSF01.Caption
"0.00")
labLCPSF01.Caption
Format(Application.WorksheetFunction.VLookup(myval2
Workbooks("BiddItDB.xls").Sheets("xl").Range("a1:b30"), 2, False)
Application.WorksheetFunction.VLookup(myval1
Workbooks("BiddItDB.xls").Sheets("xl").Range("a1:b30"), 2, False)
Application.WorksheetFunction.VLookup(labEDMat01.Caption
Workbooks("bidditdb.xls").Sheets("mat").Range("a1:e200"), 5, False)
"0.00")
labLCT01.Caption = Format(labLCPSF01.Caption * labEDSF01.Caption
"0.00")
labTC01.Caption
FormatCurrency(Application.WorksheetFunction.Sum(labLCT01.Caption
labMCT01.Caption), 2, vbUseDefault, vbUseDefault, vbUseDefault)

Else
If labT02.Caption = "" Then
'repeats the above, with 01 changed to 02 before each .caption

problem is, there are a total of 60 If's which causes error "procedur
is too large". I have read on microsoft, that the solution is to spli
the procedure into smaller ones. but not sure how that is done.

any advise
 
B

Bob Phillips

Private Sub cmdAd_Click()

Dim myval1 As Integer
Dim myval2 As Integer

Select Case True
Case lblT01.caption: DoStuff "01"
Case lblT02.caption: DoStuff "02"
'etc.
End Select

End Sub

Private Sub DoStuff(tagId)

With Me
.Controls("labT" & tagId).Caption = txtTrip.Value
.Controls("labEDWA" & tagId).Caption = txtWA.Value
.Controls("labEDFlr" & tagId).Caption = txtFlr.Value
.Controls("labEDHght" & tagId).Caption = txtHght.Value
.Controls("labEDMat" & tagId).Caption = txtMat.Value
.Controls("labEDSF" & tagId).Caption = txtSF.Value
.Controls("labEDNotes" & tagId).Caption = txtNotes.Value
myval1 = .Controls("labEDHght" & tagId).Caption
myval2 = .Controls("labEDFlr" & tagId).Caption
.Controls("labMCPSF" & tagId).Caption =
Format(Application.WorksheetFunction.VLookup( .Controls("labEDMat" &
tagId).Caption,Workbooks("bidditdb.xls").Sheets("mat").Range("a1:j200"), 10,
False),"0.00")
.Controls("labMCT" & tagId).Caption = Format( .Controls("labMCPSF" &
tagId).Caption * .Controls("labEDSF" & tagId).Caption,
"0.00")
.Controls("labLCPSF" & tagId).Caption
=Format(Application.WorksheetFunction.VLookup(myval2,Workbooks("BiddItDB.xls
").Sheets("xl").Range("a1:b30"), 2, False) +

Application.WorksheetFunction.VLookup(myval1,Workbooks("BiddItDB.xls").Sheet
s("xl").Range("a1:b30"), 2, False) + _
Application.WorksheetFunction.VLookup( .Controls("labEDMat" &
tagId).Caption,Workbooks("bidditdb.xls").Sheets("mat").Range("a1:e200"), 5,
False),
"0.00")
.Controls("labLCT" & tagId).Caption = Format( .Controls("labLCPSF &
tagId).Caption * .Controls("labEDSF" & tagId).Caption,"0.00")
.Controls("labTC" & tagId).Caption
=FormatCurrency(Application.WorksheetFunction.Sum( .Controls("labLCT" &
tagId).Caption,
.Controls("labMCT" & tagId).Caption), 2, vbUseDefault, vbUseDefault,
vbUseDefault)
End With

End Sub

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
A

AlfD

Hi!

Sharp intake of breath. Old joke about if I wanted to go there
wouldn't start from here.

One thing interests me: have you put all of these labels on one sheet
Do you need all of the labels or can you put the message in the sam
label? Is LabMCT01 essentially the same as LabMCT02 etc? Just th
caption changes? If so, things could be looking up.


But if I had to make a shot at it as it stands I would:

create a sub which (lord help us) was along these lines:

Sub cmd_Add.click()
If labT01.Caption = "" Then add01
else if If labT02.Caption = "" Then add02
else if.......


else if If labT60.Caption = "" Then add60

end if
end sub

create 60 more subs like the one you have done

sub add01()
Dim myval1 As Integer
Dim myval2 As Integer

If labT01.Caption = "" Then

labT01.Caption = txtTrip.Value
labEDWA01.Caption = txtWA.Value
labEDFlr01.Caption = txtFlr.Value
labEDHght01.Caption = txtHght.Value
labEDMat01.Caption = txtMat.Value
labEDSF01.Caption = txtSF.Value
labEDNotes01.Caption = txtNotes.Value
myval1 = labEDHght01.Caption
myval2 = labEDFlr01.Caption
labMCPSF01.Caption
Format(Application.WorksheetFunction.VLookup(labEDMat01.Caption
Workbooks("bidditdb.xls").Sheets("mat").Range("a1:j200"), 10, False)
"0.00")
labMCT01.Caption = Format(labMCPSF01.Caption * labEDSF01.Caption
"0.00")
labLCPSF01.Caption
Format(Application.WorksheetFunction.VLookup(myval2
Workbooks("BiddItDB.xls").Sheets("xl").Range("a1:b30"), 2, False)
Application.WorksheetFunction.VLookup(myval1
Workbooks("BiddItDB.xls").Sheets("xl").Range("a1:b30"), 2, False)
Application.WorksheetFunction.VLookup(labEDMat01.Caption
Workbooks("bidditdb.xls").Sheets("mat").Range("a1:e200"), 5, False)
"0.00")
labLCT01.Caption = Format(labLCPSF01.Caption * labEDSF01.Caption
"0.00")
labTC01.Caption
FormatCurrency(Application.WorksheetFunction.Sum(labLCT01.Caption
labMCT01.Caption), 2, vbUseDefault, vbUseDefault, vbUseDefault)
end sub

Then the same replacing 01 everywhere with o2 and so on to 60.

If it works, good luck! But I would honestly have a look to see i
there was some way of structuring this to use loops. I know it would b
easier in VB where indexed objects are available, but there must b
something to avoid this vast amount of repetitive coding.

Al
 
B

Bob Phillips

Slight amend

Private Sub cmdAd_Click()

Dim myval1 As Integer
Dim myval2 As Integer

Select Case True
Case lblT01.caption = "" : DoStuff "01"
Case lblT02.caption = "" : DoStuff "02"
'etc.
End Select

End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

Bob Phillips said:
Private Sub cmdAd_Click()

Dim myval1 As Integer
Dim myval2 As Integer

Select Case True
Case lblT01.caption: DoStuff "01"
Case lblT02.caption: DoStuff "02"
'etc.
End Select

End Sub

Private Sub DoStuff(tagId)

With Me
.Controls("labT" & tagId).Caption = txtTrip.Value
.Controls("labEDWA" & tagId).Caption = txtWA.Value
.Controls("labEDFlr" & tagId).Caption = txtFlr.Value
.Controls("labEDHght" & tagId).Caption = txtHght.Value
.Controls("labEDMat" & tagId).Caption = txtMat.Value
.Controls("labEDSF" & tagId).Caption = txtSF.Value
.Controls("labEDNotes" & tagId).Caption = txtNotes.Value
myval1 = .Controls("labEDHght" & tagId).Caption
myval2 = .Controls("labEDFlr" & tagId).Caption
.Controls("labMCPSF" & tagId).Caption =
Format(Application.WorksheetFunction.VLookup( .Controls("labEDMat" &
tagId).Caption,Workbooks("bidditdb.xls").Sheets("mat").Range("a1:j200"),
Click to expand...
10,
False),"0.00")
.Controls("labMCT" & tagId).Caption = Format( .Controls("labMCPSF" &
tagId).Caption * .Controls("labEDSF" & tagId).Caption,
"0.00")
.Controls("labLCPSF" & tagId).Caption
=Format(Application.WorksheetFunction.VLookup(myval2,Workbooks("BiddItDB.xls
").Sheets("xl").Range("a1:b30"), 2, False) +

Application.WorksheetFunction.VLookup(myval1,Workbooks("BiddItDB.xls").Sheet
s("xl").Range("a1:b30"), 2, False) + _
Application.WorksheetFunction.VLookup( .Controls("labEDMat" &
tagId).Caption,Workbooks("bidditdb.xls").Sheets("mat").Range("a1:e200"), 5,
False),
"0.00")
.Controls("labLCT" & tagId).Caption = Format( .Controls("labLCPSF &
tagId).Caption * .Controls("labEDSF" & tagId).Caption,"0.00")
.Controls("labTC" & tagId).Caption
=FormatCurrency(Application.WorksheetFunction.Sum( .Controls("labLCT" &
tagId).Caption,
.Controls("labMCT" & tagId).Caption), 2, vbUseDefault, vbUseDefault,
vbUseDefault)
End With

End Sub

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

need help with vba, sum of vlookups 4
need help with VBA on opening a form if Vlookup is false. 4
Blinking TEXT - Help needed 2
I need help to solve this...thanks 3
Help needed Writing formula that totals data at end of column 7

Top