If You have large data in your worksheet and you have more than 10 column in your listbox then you can use this method. It will be faster your userform.
Remember it that you should not be use any formula in userform_initilize like countif, sumifs etc.
Actually this method will work by filtering your database. When you searched your data from database then it will filter your database sheet. and after it, the filtered data will be copied and will be paste in searchdata sheet.
And when you want to create a new workbook with your filtered data, then do not use directly transfering method from listbox to new workbook. If you do it then it will run slowly.
Alternatively You can use this method where your searchdata sheet will be copied and paste it into new workbook's sheet1
Also you can save the file by vba
The vba code which i used in this project are below..............
if you want to get this file then Click Here
If you did not Subscribe my Channel Then you can Click here to Subscribe
......................................................................................................................................
Option Explicit
Private Sub cmdSearch_Click()
Application.ScreenUpdating = False
'define the worksheets
Dim sh As Worksheet ' Database sheet
Dim sht As Worksheet 'SearchData sheet
'now set the worksheets for above variables
Set sh = ThisWorkbook.Sheets("Database")
Set sht = ThisWorkbook.Sheets("SearchData")
Dim ish As Long 'for the last non-blank row number available in Database sheet
Dim isht As Long 'for the last non-blank row number available in SearachData sheet
' now declare ish to find out the last row number
ish = ThisWorkbook.Sheets("Database").Range("C" & Application.Rows.Count).End(xlUp).Row
' now clear the filter mode from the sheets if there is filtered in any column
If sh.FilterMode = True Then
sh.AutoFilterMode = False
End If
' set your fast condition which is is very mandatory that is the starting date and the ending date is to be filled up fast.
' if it is not then it will be e pop up a message box to say please enter the date period which you find out in your list box
If Me.TextBox_Start_Date = "" Or Me.TextBox_End_Date = "" Then
MsgBox "Please input Date period"
' now give exit shop for which if the condition is not filled then the code will be stopped to running
Exit Sub
End If
' now we set the conditions for two combo boxes. Here we set the conditions are as below
' condition 1 will be per the value of a combobox is all and another is not equal to all
'condition 2 is for the value of a combobox 1 is not equal to all all and combobox 2 is equal to all
' condition 3 is for the value for both combobox is not equal to all
'and the last condition that is condition for is for the value of both combo box is equal to all.
'now set the the BBA quotes if one of the above condition satisfied then the database sheet will be filtered. Here you need to to put it the field number by which is the column will be filtered
'condition1
If Me.CMB_Type.Value = "All" And Me.CMB_Status.Value <> "All" Then
sh.Range("B1:u" & ish).AutoFilter Field:=2, Criteria1:=">=" & CDate(Me.TextBox_Start_Date.Value) _
, Criteria2:="<=" & CDate(Me.TextBox_End_Date.Value)
sh.Range("B1:u" & ish).AutoFilter Field:=19, Criteria1:=Me.CMB_Status.Value
End If
'con 2
If Me.CMB_Type.Value <> "All" And Me.CMB_Status.Value = "All" Then
sh.Range("B1:u" & ish).AutoFilter Field:=2, Criteria1:=">=" & CDate(Me.TextBox_Start_Date.Value) _
, Criteria2:="<=" & CDate(Me.TextBox_End_Date.Value)
sh.Range("B1:u" & ish).AutoFilter Field:=10, Criteria1:=Me.CMB_Type.Value
End If
'çon3 '................
If Me.CMB_Type.Value <> "All" And Me.CMB_Status.Value <> "All" Then
sh.Range("B1:u" & ish).AutoFilter Field:=2, Criteria1:=">=" & CDate(Me.TextBox_Start_Date.Value) _
, Criteria2:="<=" & CDate(Me.TextBox_End_Date.Value)
sh.Range("B1:u" & ish).AutoFilter Field:=10, Criteria1:=Me.CMB_Type.Value
sh.Range("B1:u" & ish).AutoFilter Field:=19, Criteria1:=Me.CMB_Status.Value
End If
'con4
If Me.CMB_Type.Value = "All" And Me.CMB_Status.Value = "All" Then
sh.Range("B1:u" & ish).AutoFilter Field:=2, Criteria1:=">=" & CDate(Me.TextBox_Start_Date.Value) _
, Criteria2:="<=" & CDate(Me.TextBox_End_Date.Value)
End If
'now the search data sheet will be cleared by the below code
sht.Cells.Clear
' now copy e the data from database and paste it into to the search data sheet and after it you need to false the copycut mote
sh.AutoFilter.Range.Copy sht.Range("A1")
Application.CutCopyMode = False
' now find out the last row number of the search data sheet because now I will go to right the code to populate the list box and for IT you need to set the the column number buy VBA code
isht = sht.Range("A" & Application.Rows.Count).End(xlUp).Row
Me.ListBox1.ColumnCount = 20
'the the Blue coat is to show the column headers
Me.ListBox1.ColumnHeads = True
'now set the column width
Me.ListBox1.ColumnWidths = "40,90,90,90,90,80,70,70,70,50,50,50,50,50,50,50,50,50,50,50"
'condition msgbox if data found that is if there more than one ru then process will be as below that is here we set the rowsource property of listbox by the code
If isht > 1 Then
Me.ListBox1.RowSource = "SearchData!A2:t" & isht
MsgBox "Records found"
Else
' and if data is not found then it will show only e the column headers
MsgBox "No record found."
Me.ListBox1.RowSource = "SearchData!A2:t" & isht
End If
sh.AutoFilterMode = False
Application.ScreenUpdating = False
Me.TextBox1.Value = Me.ListBox1.ListCount - 1
End Sub
Private Sub CommandButton1_Click()
' ---------- Show All ---------------
Dim sh As Worksheet
Set sh = Sheets("Database")
Dim iRow As Long
iRow = sh.Range("C" & Rows.Count).End(xlUp).Row
'to populate listbox from Database sheet
With Me.ListBox1
.ColumnCount = 20
.ColumnHeads = True
.ColumnWidths = "40,90,90,90,90,80,70,70,70,50,50,50,50,50,50,50,50,50,50,50"
.RowSource = "Database!B2:u" & iRow
End With
'Now run & See
Me.TextBox1.Value = Me.ListBox1.ListCount - 1
End Sub
Private Sub CommandButton2_Click()
Dim wb, wbnew As Workbook
Dim ws As Worksheet
Set wb = Workbooks("Search data from worksheet with multiple criteria") 'Name of the workbook you are copying from
Set ws = wb.Sheets("Searchdata") 'Name of sheet you are copying
'add a new workbook
Set wbnew = Workbooks.Add
wb.Activate
'copies sheet to new workbook
wb.Sheets("Searchdata").UsedRange.Copy wbnew.Sheets(1).Range("A3")
Application.CutCopyMode = False
wbnew.SaveAs "Report" & " - " & Date
Unload Me
End Sub
Private Sub Image1_Click()
Application.ScreenUpdating = False
Dim sDate As String
On Error Resume Next
sDate = MyCalendar.DatePicker(Me.TextBox_Start_Date)
Me.TextBox_Start_Date.Value = Format(sDate, "dd-mmm-yyyy")
On Error GoTo 0
TextBox_Start_Date.SetFocus
Application.ScreenUpdating = True
End Sub
Private Sub Image2_Click()
Application.ScreenUpdating = False
Dim sDate As String
On Error Resume Next
sDate = MyCalendar.DatePicker(Me.TextBox_End_Date)
Me.TextBox_End_Date.Value = Format(sDate, "dd-mmm-yyyy")
On Error GoTo 0
TextBox_End_Date.SetFocus
Application.ScreenUpdating = True
End Sub
Private Sub Label1_Click()
ActiveWorkbook.FollowHyperlink Address:="https://www.youtube.com/c/nsutradhar?sub_confirmation=1?m=0", NewWindow:=True
End Sub
Private Sub UserForm_Initialize()
'to load listbox1 when show this userform
Dim iRow As Long
iRow = Sheet2.Range("C" & Rows.Count).End(xlUp).Row 'to find out last non blank row number
'to clear filter from sheets
ThisWorkbook.Sheets("Database").AutoFilterMode = False
ThisWorkbook.Sheets("SearchData").AutoFilterMode = False
'to clear the SearchData Sheet
ThisWorkbook.Sheets("SearchData").Cells.Clear
'-----------------------------------------------
'Now Populate ListBox1
Call CommandButton1_Click
With Userform1.CMB_Type
.AddItem "All"
.AddItem "Cash Withdrawal"
.AddItem "Money Transfer"
.Value = "All"
End With
With Userform1.CMB_Status
.AddItem "All"
.AddItem "Successful"
.AddItem "Fail"
.Value = "All"
End With
Userform1.TextBox_Start_Date.Value = Format(Date, "dd-mmm-yyyy")
Userform1.TextBox_End_Date = Format(Date, "dd-mmm-yyyy")
Me.TextBox1.Value = Me.ListBox1.ListCount - 1
End Sub
..................................................................................................................................
To Download this file please click the below download button & wait 10 sec, you will find download link
SIR CAN YOU HELP ME TO MODIFY A SHEET
ReplyDeleteYes, you can contact through email nsutradhar.cob@gmail.com
DeleteDescribe your issue along with your sheet
Thanks for you
ReplyDeleteGreat.
ReplyDeleteGRATE WORK SIR
ReplyDelete