Solved: If Without Block If
Hi All
A few weeks ago I had tremendous help from Xld with the code below and everything worked perfectly until a couple of days ago - when I got a debug message -- I realised what had caused the message but I don't know how to solve it. In columns K to O there has to be at least 3 entries of different letters if there are only 2 letters are entered and this happens very rarely the debug kicks in coloured red on line below is there a way of solving this please.
[VBA] Sub AddTheData_Click()
If Me.Tb590.Text <> "" Then
Call AddTB(Worksheets("InputData").Range("K6:K65"), _
"A", _
Range("K1"), _
Me.Tb601, Me.Tb602, Me.Tb603)
End If
If Me.Tb591.Text <> "" Then
Call AddTB(Worksheets("InputData").Range("L6:L65"), _
"B", _
Range("L1"), _
Me.Tb605, Me.Tb606, Me.Tb607)
End If
If Me.Tb592.Text <> "" Then
Call AddTB(Worksheets("InputData").Range("M6:M65"), _
"C", _
Range("M1"), _
Me.Tb609, Me.Tb610, Me.Tb611)
End If
If Me.Tb593.Text <> "" Then
Call AddTB(Worksheets("InputData").Range("N6:N65"), _
"D", _
Range("N1"), _
Me.Tb613, Me.Tb614, Me.Tb615)
End If
If Me.Tb594.Text <> "" Then
Call AddTB(Worksheets("InputData").Range("O6:O65"), _
"E", _
Range("Q1"), _
Me.Tb617, Me.Tb618, Me.Tb619)
End If
If Me.Tb595.Text <> "" Then
Call AddTB(Worksheets("InputData").Range("P6:P65"), _
"F", _
Range("P1"), _
Me.Tb620)
End If
If Me.Tb596.Text <> "" Then
Call AddTB(Worksheets("InputData").Range("Q6:Q65"), _
"G", _
Range("Q1"), _
Me.Tb621)
End If
Call Module4.Macro29
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
Private Sub Tb590_AfterUpDate()
'5p Pools
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()
'10p Pools
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()
'20p Pools
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()
'50p Pools
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()
'1.00p Pools
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()
'0.50p Single Bird Nom Pools
Tb620.Value = (Format(Val(Trim(Tb595.Value * 0.5)), "###0.00"))
End Sub
[/VBA]
Any help much appreciated
Regards
Sooty8.
Aussiebear: Edited to enable code to be wrapped by the vba tags
