• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Search data with inputBox

asparagus

Member
Hello Master,

I try to search date in multiple column with autofilter but not success, because using auto flter just working in one column and date in another column not show all.

I want change my code autofilter became input box and the result copying to new workbook, this is my code auto filter.

Code:
Private Sub Workbook_Open()
  'nama sheet di workbook
  Worksheets("Monitoring List CKD NSeries").Select 'tambahin worksheet kalo mau jalanin sheet yang berbeda
 
  With Application
  .ScreenUpdating = False
  .Calculation = xlCalculationManual
  .EnableEvents = False
  End With
 
  Dim stDate As Long: stDate = Date + 2
  Dim stDate1 As Long: stDate1 = Date + 4
  Dim count As Integer
  Dim sh As Worksheet
  Dim wbNew As Workbook
 
  count = 0
 
  'filter data yang sesuai kondisi Today + 3
  With Sheet3
  .AutoFilterMode = False
  With .Range("B6:F2000")
  .AutoFilter
  .AutoFilter Field:=1, Criteria1:=">" & stDate, _
  Operator:=xlAnd, Criteria2:="<" & stDate1
  End With
  End With
 
  Range("A6:EW2000").Copy 'copy data yang sudah di filter
 
  Workbooks.Add 'create new workbook
  Set wbNew = ActiveWorkbook 'setting new workbook sebagai active workbook
  [A4].PasteSpecial xlPasteAll 'paste data yang di copy ke new workbook
  [A4].PasteSpecial xlPasteValues
  wbNew.Sheets(1).Name = "Monitoring List CKD N-Series" ' setting untuk mengubah nama sheet di workbook baru
  wbNew.SaveAs "D:\Users\muhammad.galih\Desktop\Monitoring Lot\Reminder Monitoring Lot  " & Format(Now, "dd-mmm-yy") & ".xlsx"
  wbNew.Close 'close new workbook
 
  For Each cell In Range("B7:B1994") 'range cell
  If cell.Value = Date + 3 Then
  Cells(3, 2).Interior.ColorIndex = 3
  Cells(3, 2).Font.ColorIndex = 1
  Range("B3").Value = cell.Value 'menampilkan tanggal yang sesuai dengan tanggal hari ini +3
  count = count + 1
  Else
  End If
  Next
  ' kondisi sending email hanya 1 kali
  If count > 0 Then
  SendReminderMail
  ElseIf count = 0 Then
  End If
 
  With Application
  .ScreenUpdating = True
  .Calculation = xlCalculationAutomatic
  .EnableEvents = True
  End With
End Sub

and I upload my file to help running

Thanks,
AsparAgus
 
Last edited:
Back
Top