Hi I have a userform which allows me to add,find, and update data in a worksheet.
When i try to find data by using numbers, such as 100 or so it finds all the entries. But when it comes to trying to find data with dates it says that there is no data matching that date.
Private Sub cmbFind_Click()
Dim strFind As String 'what to find
Dim FirstAddress As String
Dim f As Integer
' imgFolder = ThisWorkbook.Path & Application.PathSeparator & "images" & Application.PathSeparator
On Error GoTo cmbFind_Click_Error
strFind = Format(Me.txtDate.Text, "dd/mm/yyyy") 'what to look for
MyData.AutoFilter
'---You may need to find a different 'find' function _
Or make the txtBody control a listbox of known Body Numbers---
Set c = MyData.Find(strFind, LookIn:=xlValues)
If Not c Is Nothing Then 'found it
'load entry to form
Me.ComboProd.Value = c.Offset(0, 1).Value
Me.txtTech.Value = c.Offset(0, 2).Value
Me.cmbAmend.Enabled = True 'allow amendment or
Me.cmbDelete.Enabled = True 'allow record deletion
Me.cmbAdd.Enabled = False 'don't want to duplicate record
R = c.Row
f = 0
FirstAddress = c.Address
Do
f = f + 1 'count number of matching records
Set c = MyData.FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
If f > 1 Then
Select Case MsgBox("There are " & f & " instances of " & strFind, vbOKCancel Or vbExclamation Or vbDefaultButton1, "Multiple entries")
Case vbOK
FindAll
Case vbCancel
'do nothing
End Select
Me.Height = frmMax
End If
Else
MsgBox strFind & " not listed" 'search failed
End If
Cleanup:
On Error Resume Next
Terminate:
On Error GoTo 0
Exit Sub
cmbFind_Click_Error:
MsgBox "There is an issue with cmbFind_Click " & vbCrLf & vbCrLf & _
Err.Number & " (" & Err.Description & ")", vbCritical, _
"Something went wrong..."
Resume Cleanup
End Sub
Private Sub cmbAmend_Click()
On Error GoTo cmbAmend_Click_Error
Application.ScreenUpdating = False
If R <= 0 Then GoTo Cleanup
Set c = ws.Cells(R, 1)
c.Value = Me.txtDate.Value ' write amendments to database
c.Offset(0, 1).Value = Me.ComboProd.Value
c.Offset(0, 2).Value = Me.txtTech.Value
c.Offset(0, 5).Value = Application.WorksheetFunction.WeekNum(Me.txtDate.Value)
c.Offset(0, 4).Value = MonthName(Me.txtDate.Value)
c.Offset(0, 3).Value = Month(Me.txtDate.Value)
c.Offset(0, 6).Value = Year(Me.txtDate.Value)
'restore Form
Me.cmbAmend.Enabled = False
Me.cmbDelete.Enabled = False
Me.cmbAdd.Enabled = True
' ClearControls
Me.Height = frmHt
If Sheet17.AutoFilterMode Then Sheet17.Range("A2").AutoFilter
Cleanup:
On Error Resume Next
Application.ScreenUpdating = True
Terminate:
On Error GoTo 0
Exit Sub
cmbAmend_Click_Error:
MsgBox "There is an issue with cmbAmend_Click " & vbCrLf & vbCrLf & _
Err.Number & " (" & Err.Description & ")", vbCritical, _
"Something went wrong..."
Resume Cleanup
End Sub
Sub FindAll()
Dim wesTemp As Worksheet
Dim strFind As String 'what to find
strFind = Me.txtBody.Value
If Not ws.AutoFilterMode Then MyData.AutoFilter
MyData.AutoFilter Field:=1, Criteria1:=strFind
Me.ListBox1.Clear
For Each c In MyData.Columns(1).SpecialCells(xlCellTypeVisible)
Me.ListBox1.AddItem c.Value
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = c.Offset(0, 1).Value
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = c.Offset(0, 2).Value
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = c.Row
Next c
End Sub
Bookmarks