Database Search filter through multiple sheets codes help needed!

[ADumbledore12345]

Hi everyone,


I'm currently tasked to handle a small project for a company I am interning at. I'm new to excel and so far my knowledge has been based off reading forums and guides online.


I'm looking to create a macro that'll allow me to search through this Excel database through multiple sheets of data. Ideally it would be able to get a filtered result from multiple excel sheets using just two keywords, found in two specific columns that can be found in most, if not all of the sheets in the excel file. Searching though the individual sheets is not really an option as there are hundreds of sheets to filter through individually.


Right now the codes I have is a combination of multiple codes I have found online. I am able to type in and search for the keywords throughout the multiple sheets, however the results that appear only shows which sheet and which column the information can be found in.


Below I have attached my macro codes that I have done so far and also the excel sheet with the macro codes and a work in progress example. The information in the original excel sheet is quite sensitive, so i have replaced them with random information.

https://drive.google.com/open?id=0BwDznf3q9P6scWJIeEpKcFFudFU

Public records As Collection
Option Base 1


Private Sub ComboBox1_Change()
ListBox1.Clear
TextBox1 = ""
TextBox2 = ""
TextBox3 = ""


End Sub


Private Sub CommandButton1_Click()


For Count = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(Count) = True Then


On Error Resume Next


RecLog = records.Count


records.Add CStr(ListBox1.List(Count) & Left(ComboBox1.Value, 4)), CStr(ListBox1.List(Count) & Left(ComboBox1.Value, 4))


On Error GoTo 0


If RecLog < records.Count Then


ListBox2.AddItem ListBox1.List(Count, 0)


For Counter = 1 To 7
          ListBox2.List(ListBox2.ListCount - 1, Counter) = ListBox1.List(Count, Counter)
Next


End If
End If
Next
End Sub
Private Sub CommandButton2_Click()
For Count = ListBox2.ListCount - 1 To 0 Step -1
If ListBox2.Selected(Count) = True Then


records.Remove CStr(ListBox2.List(Count, 0) & Left(ListBox2.List(Count, 7), 4))
ListBox2.RemoveItem (Count)


End If
Next
End Sub


Private Sub CommandButton3_Click()
If ListBox2.ListCount = 0 Then Exit Sub


'************************************************************
'
'This neat code won't work here because there are multiple source sheets
'I need  a complete row from each source sheet to the order sheet.
'
'Dim MyArray As Variant
'ReDim MyArray(ListBox2.ListCount, 6)
'For count1 = 1 To ListBox2.ListCount
'For count2 = 1 To 6
'MyArray(count1, count2) = ListBox2.List(count1 - 1, count2)
'Next
'Next
'
'With Sheets("ORDER REC")
'.Cells(Sheets("ORDER REC").Range("D1000000").End(xlUp).Row + 1, 3).Resize(UBound(MyArray), 6) = MyArray
'End With
'************************************************************


For Count = 1 To ListBox2.ListCount


Source = Range(Cells(ListBox2.List(Count - 1, 0), 1), Cells(ListBox2.List(Count - 1, 0), 10)).Address
Target = Range("A" & Sheets("ORDER REC").Range("A1000000").End(xlUp).Row + 1).Address
Sheets(ListBox2.List(Count - 1, 7)).Range(Source).Copy Sheets("ORDER REC").Range(Target)


Next


ListBox2.Clear
For Count = records.Count To 1 Step -1
records.Remove (1)
Next
End Sub


Private Sub CommandButton4_Click()
For Count = 0 To ListBox1.ListCount - 1
ListBox1.Selected(Count) = True
Next
End Sub
Private Sub CommandButton5_Click()
For Count = 0 To ListBox1.ListCount - 1
ListBox1.Selected(Count) = False
Next
End Sub
Private Sub CommandButton6_Click()
For Count = 0 To ListBox2.ListCount - 1
ListBox2.Selected(Count) = False
Next
End Sub
Private Sub CommandButton7_Click()
For Count = 0 To ListBox2.ListCount - 1
ListBox2.Selected(Count) = True
Next
End Sub






Private Sub Label1_Click()


End Sub


Private Sub Label3_Click()


End Sub


Private Sub ListBox1_Click()


End Sub


Private Sub UserForm_Activate()
Dim myshts, i As Integer
Set records = New Collection


ComboBox1.Clear
ListBox1.ColumnWidths = "40,100,100,99,99,99,49.5"
ListBox2.ColumnWidths = "40,100,100,99,99,99,49.5"


myshts = ActiveWorkbook.Sheets.Count


For i = 1 To myshts


If ActiveWorkbook.Sheets(i).Name <> "Summary Sheet" Then ComboBox1.AddItem ActiveWorkbook.Sheets(i).Name


Next i
ComboBox1.ListIndex = 1


With Me.ListBox1
End With
End Sub
Private Sub TextBox1_Change()
SearchText
End Sub
Private Sub TextBox2_Change()
SearchText
End Sub
Private Sub TextBox3_Change()
SearchText
End Sub


Private Sub SearchText()
Dim temp As Variant
Dim UniqueItem As Collection


Sheets(ComboBox1.Value).Select


temp = ActiveSheet.UsedRange.Address
TextLen = 0
Searchbox = 1


For Count = 1 To 3
If Len(Me.Controls("Textbox" & Count).Value) > TextLen Then
TextLen = Len(Me.Controls("Textbox" & Count).Value)
strValueToPick = Me.Controls("Textbox" & Count).Value
End If
Next


If TextLen < 3 Then Exit Sub


On Error Resume Next


    With Range(ActiveSheet.UsedRange.Address)
        Set rngFind = .Find(strValueToPick, .Cells(1, 1), LookIn:=xlFormulas, LookAt:=xlPart)
        If Not rngFind Is Nothing Then
            strFirstAddress = rngFind.Address
            Set rngPicked = rngFind
            Do
                Set rngPicked = Union(rngPicked, rngFind)
                Set rngFind = .FindNext(rngFind)
            Loop While Not rngFind Is Nothing And rngFind.Address <> strFirstAddress
        End If
    End With
    
    If strFirstAddress = "" Then Exit Sub
    If Not rngPicked Is Nothing Then
        rngPicked.Select
    End If


ListBox1.Clear


Set UniqueItem = New Collection
    
'Find Matches
For Each C In Selection


RowText = Join(Application.Transpose(Application.Transpose(Range(Cells(C.Row, 1), Cells(C.Row, 6)).Value)), " ")
If Len(TextBox1.Text) > 0 And InStr(LCase(RowText), Trim(LCase(TextBox1.Text))) = 0 Then GoTo 10
If Len(TextBox2.Text) > 0 And InStr(LCase(RowText), Trim(LCase(TextBox2.Text))) = 0 Then GoTo 10
If Len(TextBox3.Text) > 0 And InStr(LCase(RowText), Trim(LCase(TextBox3.Text))) = 0 Then GoTo 10


On Error Resume Next


'Remove Duplicates


UniqueItem.Add CStr(C.Row), CStr(C.Row)
On Error GoTo 0


10 Next C


For N = 1 To UniqueItem.Count
          ListBox1.AddItem UniqueItem(N)
          
For Count = 1 To 6
          ListBox1.List(ListBox1.ListCount - 1, Count) = Cells(UniqueItem(N), Count)
Next
ListBox1.List(ListBox1.ListCount - 1, 7) = ComboBox1.Value
Next


End Sub

"Combine workbook" allows me to combine multiple excel files into multiple sheets in one excel file;


"Search data" allows me to search for the keywords, using asterisk for multiple words;


"Search sheet name" allows me to search for the sheet where the keywords are located at (Useful when there is hundreds of sheets);


"Search" on the other hand is roughly what I am looking for in terms of the display, however it only searches through specific sheets and also up to the 6th or "F column".



The problem is that I can't choose which column to search the keywords in;
And also i'm unable to find any codes that will allow the results to be filtered and displayed all together.
This results in multiple irrelevant results to appear, even if they are from the same row that I am looking for.


What I am looking for is to be able to use the "search" button to search across multiple sheets (not just specific ones), and also be able to search and display past the 6th column.


Any help or suggestions will be really appreciated!


It is already much easier and faster to search using these codes as compared to searching manually through hundreds of sheets but i'm looking to streamline the process for the people working in the company.

PS: I did cross post this from another thread, just wanted to put it out there.