Issue with macro to do a search

[MSchädler]

Hi there, I have a sheet with a text field and a command button to do a search according to the text in the text field. Also I have a reset button.

The issue is that when entering numbers or dates in the text field and execute a search, the macro goes to the end of the table without showing any lines found.
Can someone tell me what I do wrong?
Thanks for your help.
Marc

Here is the link to the file in the dropbox. https://www.dropbox.com/s/xch0liyu6m3h5k6/Test_Search.xlsm?dl=0

This is the macro to do the search:
Private SubCommandButton1_Click()
IfSheets("Tabelle1").FilterMode = True Then
Sheets("Tabelle1").ShowAllData
End If

Application.EnableEvents = False
Application.ScreenUpdating = False

'Set search in cells B2-J10 for full textsearch in the fields
Sheets("Tabelle1").Cells(2,2).Value = "*" & Suchfeld.Text & "*"
Sheets("Tabelle1").Cells(3,3).Value = "*" & Suchfeld.Text & "*"
Sheets("Tabelle1").Cells(4,4).Value = "*" & Suchfeld.Text & "*"
Sheets("Tabelle1").Cells(5,5).Value = "*" & Suchfeld.Text & "*"
Sheets("Tabelle1").Cells(6,6).Value = "*" & Suchfeld.Text & "*"
Sheets("Tabelle1").Cells(7,7).Value = "*" & Suchfeld.Text & "*"
Sheets("Tabelle1").Cells(8,8).Value = "*" & Suchfeld.Text & "*"
Sheets("Tabelle1").Cells(9,9).Value = "*" & Suchfeld.Text & "*"
Sheets("Tabelle1").Cells(10,10).Value = "*" & Suchfeld.Text & "*"

' filtering according to columns M-U as persearch criteria in cells B1-J10
Sheets("Tabelle1").Columns("M:U").AdvancedFilterAction:=xlFilterInPlace, CriteriaRange:=Range _
("B1:J9"), Unique:=False
Application.ScreenUpdating = True
Application.EnableEvents = True
Range("M2").Select 'pointer to M2"

End Sub
This is the macro to do the reset:

Sub reset()
'reset filter
Application.ScreenUpdating = False
Application.EnableEvents = False

If Sheets("Tabelle1").FilterMode = True Then
Sheets("Tabelle1").ShowAllData
End If
ActiveCell.Offset(1, 0).Select

Sheets("Tabelle1").Suchfeld.Text = "" 'clears text field

If Sheets("Tabelle1").FilterMode = True Then
Sheets("Tabelle1").ShowAllData
End If

Application.ScreenUpdating = True
Application.EnableEvents = True

ActiveSheet.Range("O65536").End(xlUp).Offset(1,0).EntireRow.Select
Range("M" & (ActiveCell.Row)).Select

End Sub

 

[pbornemeier]

Re: Help needed to find issue with macro to do a search

Filtering for *7* will return "7" or '7 or '27 it will not return 7 or 27. Filters for numbers/dates do not include "contain" as an option, only comparisons like =, >, <.
To be able for your filter to work as you desire, I believe you will have to make all columns you are searching have text formatting by setting their number format to text (very easy) or add a space to all cells you are searching (very hard).

 

[MSchädler]

Re: Help needed to find issue with macro to do a search

Hello Mr. pbornemeier,

thanks for your Kind reply on my request for help.
In the meantime AFpathfinder helped me out in finding the solution that works wonderfully,


This is the vb code that he proposed:

Private Sub CommandButton1_Click()
Dim x As Integer
Dim finalRow As Integer

finalRow = Cells(Rows.Count, 1).End(xlUp).Row

Application.EnableEvents = False
Application.ScreenUpdating = False

If Sheets("Tabelle1").FilterMode = True Then
Sheets("Tabelle1").ShowAllData
End If

If Len(Suchfeld.Value) > 5 And Len(Suchfeld.Value) < 11 And InStr(Suchfeld.Value, ".") > 0 Then
Suchfeld.Value = StringToDate(Suchfeld.Value)
End If

If Suchfeld.Value <> "" And Not IsNumeric(Suchfeld.Value) And Not IsDate(Suchfeld.Value) Then
For i = 2 To 10
Cells(i, i).Value = "*" & Suchfeld.Value & "*"
Next i

ElseIf IsDate(Suchfeld.Value) Then

​

For i = 2 To 10​

​

Cells(i, i).Value = Format(Suchfeld.Value, "######")​

​

Next i​

Else
For i = 2 To 10
Cells(i, i).Value = Suchfeld.Value
Next i
End If

Sheets("Tabelle1").Columns("M:U").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range _
("B1:J9"), Unique:=False

Application.ScreenUpdating = True
Application.EnableEvents = True

Range("M2").Select 'pointer to M2"

End Sub


Function StringToDate(strDate As String) As Date
'Converts a d.m.yy date into a Date object


Dim iPeriod1 As Integer, iPeriod2 As Integer
Dim iYear As Integer
Dim iMonth As Integer
Dim iDay As Integer

iPeriod1 = InStr(strDate, ".")
iPeriod2 = InStr(iPeriod1 + 1, strDate, ".")

iDay = Left(strDate, iPeriod1 - 1)
iMonth = Mid(strDate, iPeriod1 + 1, iPeriod2 - iPeriod1 - 1)
iYear = Right(strDate, Len(strDate) - iPeriod2)

StringToDate = DateSerial(iYear, iMonth, iDay)
End Function​

Kind regard, Marc