I have a userform that will search a table and return results based on either Work Order number (column A) or Unique ID (column D). There are multiple UNIDs for each WO. When it returns to my list box if I searched for WOs then everything works great. But if I search for UNIDs it amends the starting in the middle, I've tried to search and fix this problem for a little over a week. Any help will be greatly appreciated. I've listed the entire code for my userform in case the error isnt in the PutData section. I know its long, and probably sloppy, I'm still learning vba.
Code:
Private Function FindLastRow()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Data")
'find first empty row in database
Application.ScreenUpdating = False
iRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row
FindLastRow = iRow
End Function
Private Sub Add_Click()
Set c = Range("a65536").End(xlUp).Offset(1, 0)
Application.ScreenUpdating = False
With Me
c.Value = WO.Text
c.Offset(0, 1).Value = Foreman.Text
c.Offset(0, 2).Value = System.Text
c.Offset(0, 3).Value = UNID.Text
c.Offset(0, 4).Value = Design.Value
c.Offset(0, 5).Value = Footage.Value
c.Offset(0, 6).Value = Status.Text
c.Offset(0, 7).Value = percent.Value
c.Offset(0, 8).Value = Comments.Text
ClearData
End With
Application.ScreenUpdating = True
End Sub
Private Sub Cancel_Click()
Dim c As Range
Dim rw As Long
Dim msgResponse As String
Application.ScreenUpdating = False
msg = "This will delete the selected record." & vbCr & "Do you wish to continue?"
msgResponse = MsgBox(msg, vbCritical + vbYesNo, "Delete Entry")
Select Case msgResponse
Case vbYes
Set c = ActiveCell
c.EntireRow.Select
Case vbNo
Exit Sub
End Select
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton1_Click()
ClearData
End Sub
Private Sub Save_Click()
PutData
End Sub
Private Sub Search_Click()
SearchData
End Sub
Private Sub UserForm_Initialize()
Dim rng As Range
Dim c As Range
Dim r As Long
Dim ws As Worksheet
Set ws = Worksheets("Data")
Dim wsf As Worksheet
Set wsf = Worksheets("Foreman Names")
Dim wss As Worksheet
Set wss = Worksheets("Package Status")
Dim cLoc As Range
Dim sLoc As Range
LastRow = FindLastRow
DisableSave
DisableAdd
Cells(2, 1).Select
Selection.AutoFilter
Selection.AutoFilter
For Each cLoc In wsf.Range("ForemanList")
With Me.Foreman
.AddItem cLoc.Value
End With
Next cLoc
For Each sLoc In wss.Range("StatusList")
With Me.Status
.AddItem sLoc.Value
End With
Next sLoc
End Sub
Private Sub ClearData()
Dim ws As Worksheet
Set ws = Worksheets("Data")
Application.ScreenUpdating = False
WO.Text = Empty
Foreman.Text = "Select Foreman"
System.Text = Empty
UNID.Text = Empty
Design.Text = Empty
Footage.Text = Empty
Comments.Text = Empty
Status.Text = Empty
percent.Text = Empty
Me.ListBox1.Clear
DisableSave
DisableAdd
Cells(2, 1).Select
Selection.AutoFilter
Selection.AutoFilter
Application.ScreenUpdating = True
End Sub
Private Sub DisableSave()
Save.Enabled = False
End Sub
Private Sub EnableSave()
Save.Enabled = True
End Sub
Private Sub DisableAdd()
Add.Enabled = False
End Sub
Private Sub EnableAdd()
Add.Enabled = True
End Sub
Private Sub PutData()
Application.ScreenUpdating = False
If rng Is Nothing Then GoTo Skip
For Each c In rng
If r = 0 Then c.Select
r = r - 1
Next c
Skip:
Set c = ActiveCell
c.Value = Me.WO.Text
c.Offset(0, 1).Value = Me.Foreman.Text
c.Offset(0, 2).Value = Me.System.Value
c.Offset(0, 3).Value = Me.UNID.Text
c.Offset(0, 4).Value = Me.Design.Value
c.Offset(0, 5).Value = Me.Footage.Value
c.Offset(0, 6).Value = Me.Status.Text
c.Offset(0, 7).Value = Me.percent.Text
c.Offset(0, 8).Value = Me.Comments.Text
If Sheets("data").AutoFilterMode Then Sheets("data").Range("a2").AutoFilter
Application.ScreenUpdating = True
On Error GoTo 0
End Sub
Private Sub SearchData()
Dim z As Integer
Dim strfind As String
Dim firstaddress As String
Dim rsearch As Range
Dim f As Integer
Dim ws As Worksheet
Set ws = Worksheets("Data")
Cells(2, 1).Select
Selection.AutoFilter
Selection.AutoFilter
Set rsearch = Sheets("data").Range("a1", Range("i65536").End(xlUp))
EnableSave
If Me.WO.Text = Empty And Me.UNID.Text = Empty Then
MsgBox ("Please enter a WO number or UNID then click search again.")
Exit Sub
End If
If Me.WO.Text <> Empty Then
strfind = Me.WO.Text
With rsearch
Set c = .Find(strfind, LookIn:=xlValues)
If Not c Is Nothing Then
c.Select
With Me
.Foreman.Text = c.Offset(0, 1).Value
.System.Text = c.Offset(0, 2).Value
.UNID.Text = c.Offset(0, 3).Value
.Design.Value = c.Offset(0, 4).Value
.Footage.Value = c.Offset(0, 5).Value
.Status.Text = c.Offset(0, 6).Value
.percent.Value = Val(c.Offset(0, 7).Value)
.Comments.Text = c.Offset(0, 8).Value
f = 0
End With
firstaddress = c.Address
Do
f = f + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstaddress
If f >= 1 Then
FindAll
End If
Else
MsgBox (strfind & " not listed")
Exit Sub
End If
End With
Exit Sub
End If
If Sheets("data").AutoFilterMode Then Sheets("data").Range("a2").AutoFilter
If Me.UNID.Text <> Empty Then
strfind = Me.UNID.Text
With rsearch
Set c = .Find(strfind, LookIn:=xlValues)
If Not c Is Nothing Then
c.Select
With Me
.Foreman.Text = c.Offset(0, -2).Value
.System.Text = c.Offset(0, -1).Value
.WO.Text = c.Offset(0, -3).Value
.Design.Value = c.Offset(0, 1).Value
.Footage.Value = c.Offset(0, 2).Value
.Status.Text = c.Offset(0, 3).Value
.percent.Value = Val(c.Offset(0, 4).Value)
.Comments.Text = c.Offset(0, 5).Value
f = 0
End With
firstaddress = c.Address
Do
f = f + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstaddress
If f >= 1 Then
FindAll
End If
Else
MsgBox (strfind & " not listed")
End If
End With
End If
If Sheets("data").AutoFilterMode Then Sheets("data").Range("a2").AutoFilter
End Sub
Sub FindAll()
Dim strfind As String
Dim rfilter As Range
Set rfilter = Sheets("data").Range("a2", Range("i65536").End(xlUp))
strfind = Me.WO.Text
Set rng = Sheets("data").Range("a1", Range("a65536").End(xlUp))
With Sheets("data")
If Not .AutoFilterMode Then .Range("a2").AutoFilter
rfilter.AutoFilter field:=1, Criteria1:=strfind
Set rng = rng.Cells.SpecialCells(xlCellTypeVisible)
Application.ScreenUpdating = True
Me.ListBox1.Clear
For Each c In rng
With Me.ListBox1
.AddItem c.Value
.List(.ListCount - 1, 1) = c.Offset(0, 1).Value
.List(.ListCount - 1, 2) = c.Offset(0, 2).Value
.List(.ListCount - 1, 3) = c.Offset(0, 3).Value
.List(.ListCount - 1, 4) = c.Offset(0, 4).Value
.List(.ListCount - 1, 5) = c.Offset(0, 5).Value
.List(.ListCount - 1, 6) = c.Offset(0, 6).Value
.List(.ListCount - 1, 7) = c.Offset(0, 7).Value
.List(.ListCount - 1, 8) = c.Offset(0, 8).Value
End With
Next c
End With
End Sub
Private Sub ListBox1_Click()
If Me.ListBox1.ListIndex = -1 Then
MsgBox " No Selection Made"
ElseIf Me.ListBox1.ListIndex >= 1 Then
r = Me.ListBox1.ListIndex
With Me
.WO.Value = ListBox1.List(r, 0)
.Foreman.Value = ListBox1.List(r, 1)
.System.Value = ListBox1.List(r, 2)
.UNID.Value = ListBox1.List(r, 3)
.Design.Value = ListBox1.List(r, 4)
.Footage.Value = ListBox1.List(r, 5)
.Status.Value = ListBox1.List(r, 6)
.percent.Value = ListBox1.List(r, 7)
.Comments.Value = ListBox1.List(r, 8)
.Save.Enabled = True
.Add.Enabled = True
End With
End If
End Sub
