Hi all,
I'm no expert at VBA, so I've hit a brick wall with this. Here is my code below. The problem I have is when I try to update the fields in the userform, line 25 of buttUpdate_Click causes an "object required" error and I just can't get my head round it
I'm no expert at VBA, so I've hit a brick wall with this. Here is my code below. The problem I have is when I try to update the fields in the userform, line 25 of buttUpdate_Click causes an "object required" error and I just can't get my head round it
Code:
Private Sub UserForm_Click()
Option Explicit
Dim rgData As Range
Dim rgResults As Range
Dim ListRow As Long
Dim SkipEvent As Boolean
Dim shData As Worksheet
Private Sub buttSrch_Click()
Dim shCurrent As Worksheet
Dim shResults As Worksheet
Dim found As Range
Dim firstFound As String
Dim SrchCol_1 As String
Dim SrchCol_2 As String
Dim SrchCol_3 As String
Dim r As Long
If tbSrch1 = "" And tbSrch2 = "" Then Exit Sub
Set shData = Sheets("Data") 'ch
Set rgData = shData.Cells.CurrentRegion
'Set rgData = rgData.Offset(1, 0).Resize(rgData.Rows.count - 1, rgData.Columns.count)
Set shCurrent = ActiveSheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Sheets("Results").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Sheets.Add after:=Sheets(Sheets.count)
ActiveSheet.Name = "Results"
Set shResults = Sheets("Results")
With shResults
.Cells(1, 1) = "DataRow"
.Cells(1, 2) = "Header 1" 'ch
.Cells(1, 3) = "Header 2"
.Cells(1, 4) = "Header 3"
.Cells(1, 5) = "Header 4"
.Cells(1, 6) = "Header 5"
.Cells(1, 7) = "Header 6"
.Cells(1, 8) = "Header 7"
.Cells(1, 9) = "Header 8"
.Cells(1, 10) = "Header 9"
.Cells(1, 11) = "Header 10"
.Cells(1, 12) = "Header 11"
.Cells(1, 13) = "Header 12"
.Cells(1, 14) = "Header 13"
.Cells(1, 15) = "Header 14"
.Cells(1, 16) = "Header 15"
.Cells(1, 17) = "Header 16"
.Cells(1, 18) = "Header 17"
.Cells(1, 19) = "Header 18"
End With
'columns to search thru
SrchCol_1 = "L"
'SrchCol_2 = "G"
'SrchCol_3 = "C"
lbResList.ListIndex = -1
tbResCol1 = ""
tbResCol2 = ""
tbResCol3 = ""
tbResCol4 = ""
tbResCol5 = ""
tbResCol6 = ""
tbResCol7 = ""
tbResCol8 = ""
tbResCol9 = ""
tbResCol10 = ""
tbResCol11 = ""
tbResCol12 = ""
tbResCol13 = ""
tbResCol14 = ""
tbResCol15 = ""
tbResCol16 = ""
tbResCol17 = ""
tbResCol18 = ""
r = 1
If tbSrch1 <> "" Then
With rgData.Columns(SrchCol_1)
Set found = .Find(tbSrch1, rgData.Cells(rgData.Rows.count, SrchCol_1))
If Not found Is Nothing Then
firstFound = found.Address
Do
r = r + 1
found.EntireRow.Copy shResults.Cells(r, 1)
shResults.Cells(r, 1).Insert Shift:=xlToRight
shResults.Cells(r, 1) = found.Row
Set found = .FindNext(found)
Loop While Not found Is Nothing And found.Address <> firstFound
End If
End With
End If
'If tbSrch2 <> "" Then
'With rgData.Columns(SrchCol_2)
'Set found = .Find(tbSrch2, rgData.Cells(rgData.Rows.count, SrchCol_2))
'If Not found Is Nothing Then
'firstFound = found.Address
'Do
'r = r + 1
'found.EntireRow.Copy shResults.Cells(r, 1)
'shResults.Cells(r, 1).Insert Shift:=xlToRight
'shResults.Cells(r, 1) = found.Row
'Set found = .FindNext(found)
'Loop While Not found Is Nothing And found.Address <> firstFound
'End If
'End With
'End If
'If tbSrch3 <> "" Then
'With rgData.Columns(SrchCol_3)
'Set found = .Find(tbSrch3, rgData.Cells(rgData.Rows.count, SrchCol_3))
'If Not found Is Nothing Then
'firstFound = found.Address
'Do
'r = r + 1
'found.EntireRow.Copy shResults.Cells(r, 1)
'shResults.Cells(r, 1).Insert Shift:=xlToRight
'shResults.Cells(r, 1) = found.Row
'Set found = .FindNext(found)
'Loop While Not found Is Nothing And found.Address <> firstFound
'End If
'End With
'End If
If r = 1 Then
lbResList.RowSource = ""
MsgBox "No Results"
Else
Set rgResults = shResults.Cells.CurrentRegion
Set rgResults = rgResults.Offset(1, 0).Resize(rgResults.Rows.count - 1, rgResults.Columns.count)
rgResults.RemoveDuplicates Columns:=Array(1), Header:=xlNo
Set rgResults = shResults.Cells.CurrentRegion
Set rgResults = rgResults.Offset(1, 0).Resize(rgResults.Rows.count - 1, rgResults.Columns.count)
ActiveWorkbook.Names.Add Name:="rgResults", RefersTo:=rgResults
lbResList.RowSource = "rgResults"
End If
shCurrent.Activate
Application.ScreenUpdating = True
End Sub
Private Sub buttUpdate_Click()
Dim DataRow As Long
On Error Resume Next
DataRow = lbResList.List(lbResList.ListIndex, 0)
On Error GoTo 0
If DataRow = 0 Then Exit Sub
SkipEvent = True
If tbResCol1 = "" And tbResCol2 = "" And tbResCol3 = "" And _
tbResCol4 = "" And tbResCol5 = "" And tbResCol6 = "" And _
tbResCol7 = "" And tbResCol8 = "" And tbResCol9 = "" Then
If MsgBox("Delete Entire Record?", vbExclamation + vbYesNo, "Confirm") = vbNo Then
SkipEvent = False
Exit Sub
Else
shData.Rows(DataRow).EntireRow.Delete
ListRow = lbResList.ListIndex + 1
rgResults.Rows(ListRow).EntireRow.Delete
End If
Else
If MsgBox("Do updates?", vbExclamation + vbYesNo, "Confirm") = vbNo Then
SkipEvent = False
Exit Sub
Else
With shData
'.Cells(DataRow, 1) = tbResCol1
.Cells(DataRow, 2) = tbResCol2
'.Cells(DataRow, 3) = tbResCol3
'.Cells(DataRow, 4) = tbResCol4
'.Cells(DataRow, 5) = tbResCol5
'.Cells(DataRow, 6) = tbResCol6
'.Cells(DataRow, 7) = tbResCol7
'.Cells(DataRow, 8) = tbResCol8
'.Cells(DataRow, 9) = tbResCol9
.Cells(DataRow, 10) = tbResCol10
'.Cells(DataRow, 11) = tbResCol11
.Cells(DataRow, 12) = tbResCol12
'.Cells(DataRow, 13) = tbResCol13
'.Cells(DataRow, 14) = tbResCol14
'.Cells(DataRow, 15) = tbResCol15
'.Cells(DataRow, 16) = tbResCol16
'.Cells(DataRow, 17) = tbResCol17
'.Cells(DataRow, 18) = tbResCol18
End With
With rgResults
ListRow = lbResList.ListIndex + 1
.Cells(ListRow, 2) = tbResCol1
.Cells(ListRow, 3) = tbResCol2
.Cells(ListRow, 4) = tbResCol3
.Cells(ListRow, 5) = tbResCol4
.Cells(ListRow, 6) = tbResCol5
.Cells(ListRow, 7) = tbResCol6
.Cells(ListRow, 8) = tbResCol7
.Cells(ListRow, 9) = tbResCol8
.Cells(ListRow, 10) = tbResCol9
.Cells(DataRow, 11) = tbResCol10
.Cells(DataRow, 12) = tbResCol11
.Cells(DataRow, 13) = tbResCol12
.Cells(DataRow, 14) = tbResCol13
.Cells(DataRow, 15) = tbResCol14
.Cells(DataRow, 16) = tbResCol15
.Cells(DataRow, 17) = tbResCol16
.Cells(DataRow, 18) = tbResCol17
.Cells(DataRow, 19) = tbResCol18
End With
End If
End If
SkipEvent = False
End Sub
Private Sub lbResList_Click()
If SkipEvent Then Exit Sub
With lbResList
ListRow = .ListIndex
tbResCol1 = .List(ListRow, 1)
tbResCol2 = .List(ListRow, 2)
tbResCol3 = .List(ListRow, 3)
tbResCol4 = .List(ListRow, 4)
tbResCol5 = .List(ListRow, 5)
tbResCol6 = .List(ListRow, 6)
tbResCol7 = .List(ListRow, 7)
tbResCol8 = .List(ListRow, 8)
tbResCol9 = .List(ListRow, 9)
tbResCol10 = .List(ListRow, 10)
tbResCol11 = .List(ListRow, 11)
tbResCol12 = .List(ListRow, 12)
tbResCol13 = .List(ListRow, 13)
tbResCol14 = .List(ListRow, 14)
tbResCol15 = .List(ListRow, 15)
tbResCol16 = .List(ListRow, 16)
tbResCol17 = .List(ListRow, 17)
tbResCol18 = .List(ListRow, 18)
End With
End Sub