Search by a month

[MhmdHalawi]

The code below can search by name or a specific day ( ex: 10-august-2018) but what if i want to search by a month (ex: August) can this be done here ? sheet3.cells(x,1) is for the name column and sheet3.cells(x,3) is for the date column

Sub Button1_Click()Dim lastrow As Long
Dim count As Integer
Dim n As String


lastrow = Sheet3.Cells(Rows.count, 1).End(xlUp).Row
count = 0
y = 2
a = 2
For a = 2 To lastrow
Sheet4.Cells(a, 1).ClearContents
Sheet4.Cells(a, 2).ClearContents
Sheet4.Cells(a, 3).ClearContents
Next a
n = Sheet4.Range("E1")


For x = 2 To lastrow
If Sheet3.Cells(x, 1) Like "*" & n & "*" Or Sheet3.Cells(x, 3) Like "*" & n & "*" Then
Sheet4.Cells(y, 1) = Sheet3.Cells(x, 1)
Sheet4.Cells(y, 2) = Sheet3.Cells(x, 2)
Sheet4.Cells(y, 3) = Sheet3.Cells(x, 3)
count = count + 1
y = y + 1
End If
Next x


If count = 0 Then
For y = 2 To lastrow
Sheet4.Cells(y, 1).ClearContents
Sheet4.Cells(y, 2).ClearContents
Sheet4.Cells(y, 3).ClearContents
Next y


End If
End Sub

 

[mse330]

Hi Mhmd,

Try the below code ... Couple of observations, to enhance the speed your your code, it's better to eliminate the unnecessary redundant loops. So the first loop to clear the range from A2 to C:LastRow could be replaced with 1 line to clear the contents of the range all at once instead of looping through it. Also, is the last loop needed? If the range contents is already cleared when running the macro & "Count=0" in the 2nd loop, so the range will be "Empty" anyway, isn't ?

Sub Button1_Click()
Dim LastRow As Long, Count As Integer, n As String
LastRow = sheet3.Cells(Rows.Count, 1).End(xlUp).Row
Count = 0
y = 2
sheet4.Range("A2:C" & LastRow).ClearContents
n = sheet4.Range("E1")
For x = 2 To LastRow
    If sheet3.Cells(x, 1) Like "*" & n & "*" _
    Or sheet3.Cells(x, 3) Like "*" & n & "*" _
    Or Format(sheet3.Cells(x, 3), "MMMM") = n Then
        sheet4.Cells(y, 1) = sheet3.Cells(x, 1)
        sheet4.Cells(y, 2) = sheet3.Cells(x, 2)
        sheet4.Cells(y, 3) = sheet3.Cells(x, 3)
        Count = Count + 1
        y = y + 1
    End If
Next x
If Count = 0 Then sheet4.Range("A2:C" & LastRow).ClearContents
End Sub