Solved: Userform Updating Query

[sooty8]

Hi Experts

I had a tremendous amount of help last weekend from Xld with a userform and it works great -- however my gaffer has decided on a new system to pay our agents -- basically he wants to share out the total money for each product sales as follows 1 in 20 so instead of 50% - 30% -20% which the top three agents share he wants everyone involved in the sale of a product a bite at the cherry. Xld wanted last week an example of the workbook to make sure it worked properly -- I have used Xld's code and attached what is happening now.

To get to this 1 in 20 payment if sales were 211.00 less 15% = 179.35 that means 8 agents would receive 20.00 and the 9th would get 19.35 the problem is sales 2,783 less 15% = 2,365.55 --118 agents get 20.00 & the 119 would get 5.55 -- I would need a zillion text boxes that would change each time is there a possible way round this. Add the letter A in cells column K 2 thru 150 and the letter B to column L 2 thru 150

Any help appreciated.

Regards

Sooty8.

[Bob Phillips]

Why do you need so many text boxes? Why not just have a number of agents box, a primary payment, and a secondary payment?

One question, if you had 9 agents and 165 to allocate, would it stil be 20 for 8 and 5 for the ninth, or 18 for 8 and 21 for the ninth.

[sooty8]

Hi Xld

If there were 10 agents involved with the selling and there was 179.35 available 8 would receive 20.00 the 9th = 19.35 and the 10th = 0 and if there were a 100 agents 8 would receive 20.00 the 9th = 19.35 amd the rest would get 0 -- I know its a complicated selling procedure that's why I used the letter in Column K its the top agents that get the bonus my gaffer imagines it will make the others put in more effort - I think we will be recruiting agents when those not qualifying for the bonus leave the company.

That is why I was using textboxes -- can you explain using agents and primary and secondry payments please. I just considered this was the best way to get the top earners.

Regards

Sooty8.

[Bob Phillips]

Sooty

Needs adjustment in the light of your comments, but this is the sort of thing that I mean.

[Bob Phillips]

Missed the file

[Bob Phillips]

I can't upload the file. Grab it at http://cjoint.com/?dpsSFR3uep

[sooty8]

Hi Xld

Now I understand what you mean use the textbox as entered 8 and use that as the divider or enter 20 and the textbox will display 8 and then use the column code to find the 1st / 8 and the other textbox the residual amount. Could you give me some idea of the code and I will have ago at it - unfortunately I'm away from work until late Monday when I will then get stuck into it and if I hit any snags I will before back asking for more help.

Many Thanks

Once again as Clint Eastwood said " Your making my day" or words to that effect.

Sooty8

[Bob Phillips]

I had to build the code to get the picture so you might as well have that

[vba]

Option Explicit

Private Sub Tb1_AfterUpDate()
Tb3.Value = Format(Val(Trim(Tb1.Value * 1# * 0.85)), "###0.00")
Tb2.Value = Format(Val(Trim(Tb1.Value - Tb3.Value)), "###0.00")
lbl5.Caption = ""
lbl6.Caption = ""
lbl7.Caption = ""
End Sub
Private Sub Tb11_AfterUpDate()
Tb13.Value = Format(Val(Trim(Tb11.Value * 1# * 0.85)), "###0.00")
Tb12.Value = Format(Val(Trim(Tb11.Value - Tb13.Value)), "###0.00")
lbl15.Caption = ""
lbl16.Caption = ""
lbl17.Caption = ""
End Sub
Private Sub Tb4_AfterUpDate()
Dim mpNum As Long
Dim mpShare As Long
Dim mpFirst As Double
Dim mpSecond As Double
Dim mpCaption As String

mpNum = Val(Tb4.Text)
lbl7.Visible = (mpNum > 9)
Tb7.Visible = (mpNum > 9)
mpShare = IIf(mpNum < 10, mpNum, 9)
mpFirst = Application.RoundUp(Val(Tb3.Text) / mpShare, 0)
mpSecond = Val(Tb3.Text) - (mpShare - 1) * mpFirst
If mpSecond <> 0 Then

mpCaption = mpShare - 1 & " get "
lbl5.Caption = mpCaption
Tb5.Text = Format(mpFirst, "#,##0.00")
mpCaption = "1 gets "
lbl6.Caption = mpCaption
Tb6.Text = Format(mpSecond, "#,##0.00")

lbl7.Caption = (mpNum - mpShare) & " get" & IIf(mpNum > 10, "(s)", "")
Tb7.Text = "0.00"
End If

End Sub
Private Sub Tb14_AfterUpDate()
Dim mpNum As Long
Dim mpShare As Long
Dim mpFirst As Double
Dim mpSecond As Double
Dim mpCaption As String

mpNum = Val(Tb14.Text)
lbl17.Visible = (mpNum > 9)
Tb17.Visible = (mpNum > 9)
mpShare = IIf(mpNum < 10, mpNum, 9)
mpFirst = Application.RoundUp(Val(Tb13.Text) / mpShare, 0)
mpSecond = Val(Tb13.Text) - (mpShare - 1) * mpFirst
If mpSecond <> 0 Then

mpCaption = mpShare - 1 & " get "
lbl15.Caption = mpCaption
Tb15.Text = Format(mpFirst, "#,##0.00")
mpCaption = "1 gets "
lbl16.Caption = mpCaption
Tb16.Text = Format(mpSecond, "#,##0.00")

lbl17.Caption = (mpNum - mpShare) & " get" & IIf(mpNum > 10, "(s)", "")
Tb17.Text = "0.00"
End If

End Sub

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

Call AddTB(rng:=Worksheets("Sheet1").Range("K2:K150"), _
LookFor:="A", _
NotFound:=Range("K1"), _
Num:=IIf(Val(Me.Tb4.Text) > 9, 9, Val(Me.Tb4.Text)), _
Amt1:=Val(Me.Tb5.Text), _
Amt2:=Val(Me.Tb6.Text))
End If
If Me.Tb11.Text <> "" Then

Call AddTB(rng:=Worksheets("Sheet1").Range("L2:L150"), _
LookFor:="B", _
NotFound:=Range("L1"), _
Num:=IIf(Val(Me.Tb14.Text) > 9, 9, Val(Me.Tb14.Text)), _
Amt1:=Val(Me.Tb15.Text), _
Amt2:=Val(Me.Tb16.Text))
End If
End Sub

Private Sub AddTB(ByRef rng As Range, _
ByVal LookFor As String, _
ByVal NotFound As Range, _
ByVal Num As Long, _
ByVal Amt1 As Double, _
ByVal Amt2 As Double)
Dim rng1 As Range
Dim sAddr As String
Dim mpExit As Boolean
Dim i As Long

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

rng1.Value = Amt1
sAddr = rng1.Address
i = 2
Do

On Error Resume Next
Set rng1 = rng.FindNext(rng1)
On Error GoTo 0
If Not rng1 Is Nothing Then

If i < Num Then

rng1.Value = Amt1
Else

rng1.Value = Amt2
End If

i = i + 1
End If

mpExit = rng1 Is Nothing
If Not mpExit Then

If i > Num Or rng1.Address = sAddr Then

mpExit = True
End If
End If
Loop Until mpExit
Else

MsgBox NotFound.Value & " was not found"
End If
End Sub

Private Sub Clear_Click()
Application.ScreenUpdating = False
Dim cell As Range

For Each cell In ActiveWorkbook.Worksheets("Sheet1").Range("K2:L150")

If Not IsNumeric(cell.Value) Then

cell.ClearContents
End If
Next cell
Application.ScreenUpdating = True
End Sub
[/vba]

[sooty8]

Hi Xld

Had a go at trying to match form to your code and I was struggling however made a smaller form and adapted your code and using the figures you entered it works OK but I get a different result say when entering 1000 in Tb1 it displays correct figures to Tb3 after that goes a bit haywire
it still divides by 8 so instead of showing 42@20.00 it displays 8 gets 95.00 & 1 gets 90.00 - 34 gets 0.00 is right -- I have no idea how to change this have attached amended form & sheet any help or idea's much appreciated

Regards

Sooty8.

[Bob Phillips]

That is what I thought the rule was, the money is shared between a max of 9, and the rset get 0. What is the rule?

[sooty8]

Hi Xld
It has to be me not explaining properly the division is 20 as previous post if the total sales are ?1,000.00 - Company % is 15 = ?150.00 - ?850.00 shared by 95 agents only the 1st 42 would get ?20.00 - 1 would get ?10.00 which would total the ?850.00. Some of the Total Sales figures could be as high as ?5,000.00 if that were the case - % = ?750 which leaves ?4,250 therefore the 1st 212 would get ?20.00 and 1 would get ?10.00.

Hope this is a better explanation

Regards

Sooty8.

[Bob Phillips]

[vba]

Option Explicit

Private mmShare As Long

Private Sub Tb1_AfterUpDate()
Tb3.Value = Format(Val(Trim(Tb1.Value * 1# * 0.85)), "###0.00")
Tb2.Value = Format(Val(Trim(Tb1.Value - Tb3.Value)), "###0.00")

If Me.Tb4.Text <> "" Then Call CalculateShare

End Sub

Private Sub Tb4_AfterUpDate()

Call CalculateShare
End Sub

Private Sub CalculateShare()
Dim mpNum As Long
Dim mpShare As Long
Dim mpFirst As Double
Dim mpSecond As Double
Dim mpCaption As String

Lb5.Caption = ""
Lb6.Caption = ""
Lb7.Caption = ""

mpNum = Val(Tb4.Text)
mmShare = Application.RoundUp(Val(Tb3.Text) / 20, 0)
mmShare = IIf(mpNum < mmShare, mpNum, mmShare)

mpFirst = 20
mpSecond = Val(Tb3.Text) - (mmShare - 1) * mpFirst
If mpSecond >= 20 Then mpSecond = 0
If mpSecond = 0 Then

Lb5.Caption = mmShare & " get"
Else

Lb5.Caption = mmShare - 1 & " get"
End If
Tb5.Text = Format(mpFirst, "#,##0.00")

Lb6.Visible = (mpNum <> mmShare) Or (mpSecond <> 0)
Tb6.Visible = (mpNum <> mmShare) Or (mpSecond <> 0)
If mpSecond <> 0 Then

Lb6.Caption = "1 gets"
Tb6.Text = Format(mpSecond, "#,##0.00")
Else

Lb6.Caption = mpNum - mmShare & " get"
Tb6.Text = Format(0, "#,##0.00")
End If

Lb7.Visible = (mpNum <> mmShare) And (mpSecond <> 0)
Tb7.Visible = (mpNum <> mmShare) And (mpSecond <> 0)
Lb7.Caption = mpNum - mmShare & " get"
Tb7.Text = Format(0, "#,##0.00")

End Sub

Sub AddTheData_Click()
Dim mpShare As Long

If Me.Tb1.Text <> "" Then

mpShare = Application.RoundUp(Val(Tb3.Text) / 20, 0)
mpShare = IIf(Me.Tb4.Text < mpShare, Me.Tb4.Text, mpShare)
Call AddTB(rng:=Worksheets("Sheet1").Range("K2:K150"), _
LookFor:="A", _
NotFound:=Range("K1"), _
Num:=mpShare, _
Amt1:=Val(Me.Tb5.Text), _
Amt2:=Val(Me.Tb6.Text))
End If
End Sub

Private Sub AddTB(ByRef rng As Range, _
ByVal LookFor As String, _
ByVal NotFound As Range, _
ByVal Num As Long, _
ByVal Amt1 As Double, _
ByVal Amt2 As Double)
Dim rng1 As Range
Dim sAddr As String
Dim mpExit As Boolean
Dim i As Long

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

rng1.Value = Amt1
sAddr = rng1.Address
i = 2
Do

On Error Resume Next
Set rng1 = rng.FindNext(rng1)
On Error GoTo 0
If Not rng1 Is Nothing Then

If i < Num Then

rng1.Value = Amt1
Else

rng1.Value = Amt2
End If

i = i + 1
End If

mpExit = rng1 Is Nothing
If Not mpExit Then

If i > Num Or rng1.Address = sAddr Then

mpExit = True
End If
End If
Loop Until mpExit
Else

MsgBox NotFound.Value & " was not found"
End If
End Sub

Private Sub Clear_Click()
Application.ScreenUpdating = False
Dim cell As Range

For Each cell In ActiveWorkbook.Worksheets("Sheet1").Range("K2:L150")

If Not IsNumeric(cell.Value) Then

cell.ClearContents
End If
Next cell
Application.ScreenUpdating = True

End Sub
[/vba]

[sooty8]

Hi Xld

Magnificent -- they have had us in a meeting this morning for 2 hours only just been able to have a trial run and as usual 1st time of asking brilliant and exactly what is necessary, have to say much of the code I don't understand how it works and runs so smoothly -- all I have to do now is get my head round having 11 products on the Userform -- using the next 10 columns -- Many, Many Thanks for your time and effort --

Kind Regards

Sooty8.

ps -- for some reason I don't receive Emails when a reply is posted -- so I just keep coming back and having a look

[Bob Phillips]

I have email notification switched off. Emails are a pain, a workflow breaker, not a workflow assister IMO.