Hello,
I am trying to design a user form using a sample workbook I found on the forum to Search,Edit,Add,Delete a table within a worksheet.
The table is called table5 and has 9 columns
I've modified the code however I'm getting 'Subscript ou of range' error
Option Explicit
Dim sc As Long, i As Long
Dim answer As VbMsgBoxResult
Dim LookupValue As String
Dim ws1 As Worksheet
Dim tbl1 As ListObject
Dim FoundCell As Range
Dim newrow As ListRow
Dim response As VbMsgBoxResult
Private Sub txtbox1_AfterUpdate()
With lbo1
For i = 0 To .ListCount - 1
If .List(i, 0) = txtbox1.Text Then
txtbox1 = .List(i, 0)
txtbox2 = .List(i, 1)
txtbox3 = .List(i, 2)
txtbox4 = .List(i, 3)
txtbox5 = .List(i, 4)
txtbox6 = .List(i, 5)
txtbox7 = .List(i, 6)
txtbox8 = .List(i, 7)
txtbox9 = .List(i, 8)
sc = i + 2
Exit For
End If
Next i
End With
End Sub
Private Sub lbo1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Me.lbo1.ListIndex = -1 Then Exit Sub
If Me.lbo1.ListIndex > -1 Then sc = Me.lbo1.ListIndex + 2
ClearForm
Set ws1 = Sheet1
Set tbl1 = ws1.ListObjects("Table5")
With tbl1
For i = 1 To 9
Controls("txtbox" & i).Value = .Range(sc, i)
Next i
End With
End Sub
Private Sub cmdadd_Click()
'check for a serial number
If Trim(Me.txtbox4.Value) = "" Then
Me.txtbox4.SetFocus
MsgBox "Please enter a Serial number"
Exit Sub
End If
Set ws1 = Sheet1
Set tbl1 = ws1.ListObjects("Table5")
LookupValue = Me.txtbox4.Value
On Error Resume Next
Set FoundCell = tbl1.DataBodyRange.Columns(5).Find(LookupValue, LookAt:=xlWhole)
On Error GoTo 0
If Not FoundCell Is Nothing Then
answer = MsgBox("This Serial Number already in file." & vbCrLf & "Do you want to add a duplicate", vbQuestion + vbYesNo + vbDefaultButton2, "another ?")
If answer = vbNo Then
Me.txtbox4.Value = ""
Me.txtbox4.SetFocus
Exit Sub
End If
End If
Set newrow = tbl1.ListRows.add
With newrow
For i = 1 To 9
.Range(i) = Controls("txtbox" & i).Value
Next i
End With
ClearForm
LoadListBox
End Sub
Private Sub cmdclear_Click()
MsgBox ("This action only clears the form NOT the record" & vbCrLf & "Ready for adding NEW entry."), vbOKOnly, "Clear Form "
ClearForm
End Sub
Private Sub cmddelete_Click()
If Me.txtbox4 = "" Then
MsgBox "No Item selected", , "Errors"
Exit Sub
End If
response = MsgBox("ARE YOU CERTAIN YOU WISH TO REMOVE RECORD ?", vbCritical + vbYesNo + vbDefaultButton2, "Remove Record")
If response = vbNo Then
ClearForm
Exit Sub
End If
Set ws1 = Sheet1
Set tbl1 = ws1.ListObjects("Table5")
tbl1.ListRows(sc - 1).DELETE
ClearForm
LoadListBox
MsgBox (" RECORD REMOVED"), vbOKOnly + vbInformation, "Record Removed"
End Sub
Private Sub cmdedit_Click()
If Me.txtbox4 = "" Then
MsgBox "No Item selected", , "Errors"
Exit Sub
End If
Set ws1 = Sheet1
Set tbl1 = ws1.ListObjects("Table5")
With tbl1.ListRows(sc - 1)
For i = 1 To 9
.Range(i) = Controls("txtbox" & i).Value
Next i
End With
ClearForm
LoadListBox
MsgBox ("Details Changed"), vbOKOnly + vbInformation, "SAVED"
End Sub
Private Sub UserForm_Initialize()
ClearForm
LoadListBox
End Sub
Private Sub cmdclose_Click()
ThisWorkbook.Save
Unload Me
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
Cancel = True
MsgBox "Please use the Close Form button!"
End If
End Sub
Can anyone help?
Thanks
Bookmarks