Solved: Joining Code of several Add Buttons on a UserForm

[sooty8]

Hi Experts

Just had one problem solved and I wondered if there was anyway that the following could be made to work with just 1 CommandButton on the UserForm instead of 6.
On occasion some of the TextBoxes (Tb AfterUpdate) would have no value entered.

Private Sub Tb590_AfterUpDate()
Tb600.Value = Format(Val(Trim(Tb590.Value * 0.05)), "###0.00")
Tb601.Value = (Format(Val(Trim(Tb600.Value * 0.5)), "###0.00"))
Tb602.Value = (Format(Val(Trim(Tb600.Value * 0.3)), "###0.00"))
Tb603.Value = (Format(Val(Trim(Tb600.Value * 0.2)), "###0.00"))
End Sub
Private Sub Tb591_AfterUpDate()
Tb604.Value = Format(Val(Trim(Tb591.Value * 0.1)), "###0.00")
Tb605.Value = (Format(Val(Trim(Tb604.Value * 0.5)), "###0.00"))
Tb606.Value = (Format(Val(Trim(Tb604.Value * 0.3)), "###0.00"))
Tb607.Value = (Format(Val(Trim(Tb604.Value * 0.2)), "###0.00"))
End Sub
Private Sub Tb592_AfterUpdate()
Tb608.Value = Format(Val(Trim(Tb592.Value * 0.2)), "###0.00")
Tb609.Value = (Format(Val(Trim(Tb608.Value * 0.5)), "###0.00"))
Tb610.Value = (Format(Val(Trim(Tb608.Value * 0.3)), "###0.00"))
Tb611.Value = (Format(Val(Trim(Tb608.Value * 0.2)), "###0.00"))
End Sub
Private Sub Tb593_AfterUpdate()
Tb612.Value = (Format(Val(Trim(Tb593.Value * 0.5)), "###0.00"))
Tb613.Value = (Format(Val(Trim(Tb612.Value * 0.5)), "###0.00"))
Tb614.Value = (Format(Val(Trim(Tb612.Value * 0.3)), "###0.00"))
Tb615.Value = (Format(Val(Trim(Tb612.Value * 0.2)), "###0.00"))
End Sub
Private Sub Tb594_AfterUpdate()
Tb616.Value = (Format(Val(Trim(Tb594.Value * 1#)), "###0.00"))
Tb617.Value = (Format(Val(Trim(Tb616.Value * 0.5)), "###0.00"))
Tb618.Value = (Format(Val(Trim(Tb616.Value * 0.3)), "###0.00"))
Tb619.Value = (Format(Val(Trim(Tb616.Value * 0.2)), "###0.00"))
End Sub
Private Sub Tb595_AfterUpdate()
Tb620.Value = (Format(Val(Trim(Tb595.Value * 1#)), "###0.00"))
End Sub

Many Thanks

Sooty8

[Bob Phillips]

What does this have to do with commandbuttons?

What should happen if the textbox is empty afterupdate?

[sooty8]

Hi Xld
Thanks for having a look -- rough weekend weather wise in the UK hence the delay for my reply.
If I just take one piece of code as below -- what happens is I enter a total in Tb591 say 100 ( the update happens on entering the last digit of 100) Tb600 then uses Tb591 total and shows a currency value for the 100 entered the other Tb's then take a % of Tb600 and on then clicking the CommandButton those % currency values enter the correct cells on the sheet. I have 6 CommandButtons all doing the same thing - I was hoping to get them all on to 1 CommandButton on presenting the query I realised that sometimes Tb591 would have nothing entered - would that stop the code running??
Private Sub Tb590_AfterUpDate()
Tb600.Value = Format(Val(Trim(Tb590.Value * 0.05)), "###0.00")
Tb601.Value = (Format(Val(Trim(Tb600.Value * 0.5)), "###0.00"))
Tb602.Value = (Format(Val(Trim(Tb600.Value * 0.3)), "###0.00"))
Tb603.Value = (Format(Val(Trim(Tb600.Value * 0.2)), "###0.00"))
End Sub

Once again thanks for having a look hope this explains my problem -- it works OK at the moment trying to speed things up for when I'm under pressure to finish a report.

Regards

Sooty8.

[Bob Phillips]

But you are not showing what the commandbuttons do, so it would be guesswork on our part.

Empty textboxes should be okay as you Val() them.

[sooty8]

Hi Xld

Misunderstanding on my part -- here is the code for the Commandbuttons it goes on a bit I'm afraid.

Sub Add500_Click()
Dim v(1 To 3), rng As Range, rng1 As Range
Dim sAddr As String, ii As Long
Set rng = Worksheets("InputData").Range("K6:K40")
Set rng1 = rng.Find(What:="A", _
After:=rng(rng.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rng1 Is Nothing Then
v(1) = Evaluate(Me.Tb601.Text)
v(2) = Evaluate(Me.Tb602.Text)
v(3) = Evaluate(Me.Tb603.Text)
ii = 1
sAddr = rng1.Address
Do
rng1.Offset(0, 0).Value = Application.Large(v, ii)
Set rng1 = rng.FindNext(rng1)
ii = ii + 1
Loop Until rng.Address = sAddr Or ii > 3
Else
MsgBox Range("K1").Value & " was not found"
End If
End Sub
Sub Add501_Click()
Dim v(1 To 3), rng As Range, rng1 As Range
Dim sAddr As String, ii As Long
Set rng = Worksheets("InputData").Range("L6:L40")
Set rng1 = rng.Find(What:="B", _
After:=rng(rng.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rng1 Is Nothing Then
v(1) = Evaluate(Me.Tb605.Text)
v(2) = Evaluate(Me.Tb606.Text)
v(3) = Evaluate(Me.Tb607.Text)
ii = 1
sAddr = rng1.Address
Do
rng1.Offset(0, 0).Value = Application.Large(v, ii)
Set rng1 = rng.FindNext(rng1)
ii = ii + 1
Loop Until rng.Address = sAddr Or ii > 3
Else
MsgBox Range("L1").Value & " was not found"
End If
End Sub
Sub Add502_Click()
Dim v(1 To 3), rng As Range, rng1 As Range
Dim sAddr As String, ii As Long
Set rng = Worksheets("InputData").Range("M6:M40")
Set rng1 = rng.Find(What:="C", _
After:=rng(rng.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rng1 Is Nothing Then
v(1) = Evaluate(Me.Tb609.Text)
v(2) = Evaluate(Me.Tb610.Text)
v(3) = Evaluate(Me.Tb611.Text)
ii = 1
sAddr = rng1.Address
Do
rng1.Offset(0, 0).Value = Application.Large(v, ii)
Set rng1 = rng.FindNext(rng1)
ii = ii + 1
Loop Until rng.Address = sAddr Or ii > 3
Else
MsgBox Range("M1").Value & " was not found"
End If
End Sub
Sub Add503_Click()
Dim v(1 To 3), rng As Range, rng1 As Range
Dim sAddr As String, ii As Long
Set rng = Worksheets("InputData").Range("N6:N40")
Set rng1 = rng.Find(What:="D", _
After:=rng(rng.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rng1 Is Nothing Then
v(1) = Evaluate(Me.Tb613.Text)
v(2) = Evaluate(Me.Tb614.Text)
v(3) = Evaluate(Me.Tb615.Text)
ii = 1
sAddr = rng1.Address
Do
rng1.Offset(0, 0).Value = Application.Large(v, ii)
Set rng1 = rng.FindNext(rng1)
ii = ii + 1
Loop Until rng.Address = sAddr Or ii > 3
Else
MsgBox Range("N1").Value & " was not found"
End If
End Sub
Sub Add504_Click()
Dim v(1 To 3), rng As Range, rng1 As Range
Dim sAddr As String, ii As Long
Set rng = Worksheets("InputData").Range("O6:O40")
Set rng1 = rng.Find(What:="E", _
After:=rng(rng.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rng1 Is Nothing Then
v(1) = Evaluate(Me.Tb617.Text)
v(2) = Evaluate(Me.Tb618.Text)
v(3) = Evaluate(Me.Tb619.Text)
ii = 1
sAddr = rng1.Address
Do
rng1.Offset(0, 0).Value = Application.Large(v, ii)
Set rng1 = rng.FindNext(rng1)
ii = ii + 1
Loop Until rng.Address = sAddr Or ii > 3
Else
MsgBox Range("O1").Value & " was not found"
End If
End Sub
Sub Add505_Click()
Dim v(1 To 1), rng As Range, rng1 As Range
Dim sAddr As String, ii As Long
Set rng = Worksheets("InputData").Range("P6:P40")
Set rng1 = rng.Find(What:="F", _
After:=rng(rng.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rng1 Is Nothing Then
v(1) = Evaluate(Me.Tb620.Text)
'v(2).Value = "" 'Evaluate(Me.Tb618.)
'v(3).Value = "" 'Evaluate(Me.Tb619.Text)
ii = 1
sAddr = rng1.Address
Do
rng1.Offset(0, 0).Value = Application.Large(v, ii)
Set rng1 = rng.FindNext(rng1)
ii = ii + 1
Loop Until rng.Address = sAddr Or ii > 1
Else
MsgBox Range("P1").Value & " was not found"
End If
End Sub
Sub Add506_Click()

Dim v(1 To 1), rng As Range, rng1 As Range
Dim sAddr As String, ii As Long
Set rng = Worksheets("InputData").Range("Q6:Q40")
Set rng1 = rng.Find(What:="G", _
After:=rng(rng.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rng1 Is Nothing Then
v(1) = Evaluate(Me.Tb621.Text)
'v(2).Value = "" 'Evaluate(Me.Tb618.)
'v(3).Value = "" 'Evaluate(Me.Tb619.Text)
ii = 1
sAddr = rng1.Address
Do
rng1.Offset(0, 0).Value = Application.Large(v, ii)
Set rng1 = rng.FindNext(rng1)
ii = ii + 1
Loop Until rng.Address = sAddr Or ii > 1
Else
MsgBox Range("Q1").Value & " was not found"
End If
End Sub

As soon as 3 entries are found for the different letters the %'s replace the letters the letters are entered into the ranges via textboxes.

Regards

Sooty8

[Bob Phillips]

Is this what you mean



Sub Add500_Click()
Call AddTB(Worksheets("InputData").Range("K6:K40"), _
"A", _
Range("K1"), _
Me.Tb601, Me.TB602, Me.TB603)
End Sub
Sub Add501_Click()
Call AddTB(Worksheets("InputData").Range("L6:L40"), _
"B", _
Range("L1"), _
Me.Tb605, Me.TB606, Me.TB607)
End Sub
Sub Add502_Click()
Call AddTB(Worksheets("InputData").Range("M6:M40"), _
"C", _
Range("M1"), _
Me.Tb609, Me.TB610, Me.TB611)
End Sub
Sub Add503_Click()
Call AddTB(Worksheets("InputData").Range("N6:N40"), _
"D", _
Range("N1"), _
Me.Tb613, Me.TB614, Me.TB615)
End Sub
Sub Add504_Click()
Call AddTB(Worksheets("InputData").Range("O6:O40"), _
"E", _
Range("Q1"), _
Me.Tb617, Me.TB618, Me.TB619)
End Sub
Sub Add505_Click()
Call AddTB(Worksheets("InputData").Range("P6:P40"), _
"F", _
Range("P1"), _
Me.Tb62o)
End Sub
Sub Add506_Click()
Call AddTB(Worksheets("InputData").Range("Q6:Q40"), _
"G", _
Range("Q1"), _
Me.Tb621)
End Sub

Sub AddTB(rng As Range, LookFor As String, NotFound As Range, ParamArray TB())
Dim v(), rng1 As Range
Dim sAddr As String, ii As Long
Dim i As Long

ReDim v(1 To UBound(TB) - LBound(TB) + 1)

Set rng1 = rng.Find(What:=LookFor, _
After:=rng(rng.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rng1 Is Nothing Then
For i = 1 To UBound(TB) - LBound(TB) + 1
v(i) = Evaluate(TB(i + LBound(TB) - 1).Text)
Next i
ii = 1
sAddr = rng1.Address
Do
rng1.Offset(0, 0).Value = Application.Large(v, ii)
Set rng1 = rng.FindNext(rng1)
ii = ii + 1
Loop Until rng.Address = sAddr Or ii > UBound(TB) - LBound(TB) + 1
Else
MsgBox NotFound.Value & " was not found"
End If
End Sub

[sooty8]

Hi Xld

Wow!! just done a test worked spot on except for 1 typo error that the debugger picked up --if it hadn't -- I would not have found it. The code is smaller quicker and more efficient -- however my original question was to get it all on 1 commandbutton instead of 6 -- when the agents are phoning in for there % bonus's and commisions on a daily basis -- I just thought that 1 commandbutton would get them off my back and phone faster and I could leave the office earlier.

Many Thanks

Sooty8.

[Bob Phillips]

Okay, I think that will be possible.

Tow things you can do though. First, tell me how if we just have one button how do we know whether to do what Add500_Click does, or what Add501_Click does, and so on.

And secondly, can you post your workbook? I can test it then.

[sooty8]

Hi Xld

First off I dare not post the workbook to much sensitive info -- plus there are regular checks on our systems -- that would if found -- cost me my job!! and an awful lot of people have been made redundant over the last few years.
If the Text Boxes where I enter the totals are empty it would just ignore them all and do all the other calcs for the sheet on that day --
My friend thank you for your interest and help but if its to difficult to do with out testing it in the workbook -- it looks like we will have to close the issue now, which is a shame as your tremendous knowledge and help nearly resolved it all.

Kind Regards

Sooty8.

p.s. I'm sure one day I'll " BE BACK ":beerchug:

[Bob Phillips]

That is understood.

Let's keep trying a biut more though.

Heres is a stab based upon textboxes named T500-Tb506. You will know what they should be, but is this anywhere near close?

BTW, the compile error might still be there as I don't know what it was



Sub AddTheData_Click()
If Me.TB500.Text <> "" Then

Call AddTB(Worksheets("InputData").Range("K6:K40"), _
"A", _
Range("K1"), _
Me.Tb601, Me.TB602, Me.TB603)
End If

If Me.TB501.Text <> "" Then

Call AddTB(Worksheets("InputData").Range("L6:L40"), _
"B", _
Range("L1"), _
Me.Tb605, Me.TB606, Me.TB607)
End If

If Me.TB502.Text <> "" Then

Call AddTB(Worksheets("InputData").Range("M6:M40"), _
"C", _
Range("M1"), _
Me.Tb609, Me.TB610, Me.TB611)
End If

If Me.TB503.Text <> "" Then

Call AddTB(Worksheets("InputData").Range("N6:N40"), _
"D", _
Range("N1"), _
Me.Tb613, Me.TB614, Me.TB615)
End If

If Me.TB504.Text <> "" Then

Call AddTB(Worksheets("InputData").Range("O6:O40"), _
"E", _
Range("Q1"), _
Me.Tb617, Me.TB618, Me.TB619)
End If

If Me.TB505.Text <> "" Then

Call AddTB(Worksheets("InputData").Range("P6:P40"), _
"F", _
Range("P1"), _
Me.Tb62o)
End If

If Me.TB506.Text <> "" Then

Call AddTB(Worksheets("InputData").Range("Q6:Q40"), _
"G", _
Range("Q1"), _
Me.Tb621)
End If
End Sub

Sub AddTB(rng As Range, LookFor As String, NotFound As Range, ParamArray TB())
Dim v(), rng1 As Range
Dim sAddr As String, ii As Long
Dim i As Long

ReDim v(1 To UBound(TB) - LBound(TB) + 1)

Set rng1 = rng.Find(What:=LookFor, _
After:=rng(rng.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rng1 Is Nothing Then
For i = 1 To UBound(TB) - LBound(TB) + 1
v(i) = Evaluate(TB(i + LBound(TB) - 1).Text)
Next i
ii = 1
sAddr = rng1.Address
Do
rng1.Offset(0, 0).Value = Application.Large(v, ii)
Set rng1 = rng.FindNext(rng1)
ii = ii + 1
Loop Until rng.Address = sAddr Or ii > UBound(TB) - LBound(TB) + 1
Else
MsgBox NotFound.Value & " was not found"
End If
End Sub

[sooty8]

Hi Xld

Now that my phone has stopped ringing after 2 hours non - stop I have at last had time to use your code ( by the way the error was -- Me.Tb62o) and as usual it worked spot on 1st time of asking -- thank you so much for getting rid of loads of code and buttons that are not needed -- I have another page with very similar stuff and loads of commandbuttons -- I will have a go tomorrow and try to adapt what you have done today to my new page -- once again thanks for the help -- can now go home and listen, watch and see what the awful weather has left of my house.

Kind Regards

Sooty8.