Solved: If Without Block If

[sooty8]

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

[lucas]

I hesitate to suggest this without taking the time to look a little closer but you might try adding this right after the redim statement:

[VBA]
On Error Resume Next
[/VBA]

[sooty8]

Hi Lucas

Thanks for the help -- works just right now --- don't know why I didn't find the answer perhaps it's "Old Timers" disease -- kicking in

Regards

Sooty8.