WashHandsWithChamploo
New Member
- Joined
- Aug 6, 2014
- Messages
- 11
the problem lies with creating the wkBookList which is supposedly a variant that holds an array, and in the sub I am calling the function GetFileList which supposedly is supposed to return a variant holding a string array, yet for some reason I get a type mismatch.
Code:
'Create Workbook List, this variant holding the string array will then be passed to the function FilterTheFileList along with '2 other filter keywords.
Option Explicit
Private Function GetFileList(Optional strFilter As String) As Variant
Dim strFolder As String
Dim varFileList() As String
Dim f As String
Dim i As Integer
' Get the directory from the user
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
If .SelectedItems.Count = 0 Then Exit Function 'user cancelled
strFolder = .SelectedItems(1)
End With
' Get a list of all the files in this directory.
If strFilter = "" Then strFilter = "*.*"
Select Case Right$(strFolder, 1)
Case "\", "/"
strFolder = Left$(strFolder, Len(strFolder) - 1)
End Select
ReDim Preserve varFileList(0)
f = Dir$(strFolder & "\" & strFilter)
Do While Len(f) > 0
ReDim Preserve varFileList(i) As String
varFileList(i) = f
i = i + 1
f = Dir$()
Loop
If varFileList(0) <> Empty Then
GetFileList = varFileList
Else
MsgBox "No Files Found", vbInformation
Exit Function
End If
End Function
'For future purposes it's best to probably find a way to condense the repating code for the 2 cases of whether user knows 1 or 2 facts about the component that he/she is trying to find
'Returns array of cell addresses and from which workbook and worksheet they came from.
'Takes the variant holding the filtered down array of wkbooks from the function FilterTheFileList.
Private Function FilterResultsEvenFurther(Results As Variant, filterS As String, filterS2 As String) As Variant
Dim ct As Long
Dim ct2 As Long
Dim wkbookAndWksheetInfo As String
Dim wkb As Workbook
Dim wrdArr() As String
Dim fileN As Variant
Dim sht As Worksheet
Dim c As Range
Dim arrCnt As Long
Dim cAddressArr() As Variant
Dim conf As String
conf = Application.InputBox("Do you think you know 2 general facts about your specific component?(Y/N)Example: When describing a resistor we consider resistance value, what type of resistor it is (power,variable,ceramic)")
arrCnt = 0
If conf = "Y" Or "y" Then
For ct = 1 To Results.GetUpperBound(0)
For ct2 = 1 To Results(ct).GetUpperBound(0)
wkbookAndWksheetInfo = Results(ct)(ct2)
wrdArr = Split(wkbookAndWksheetInfo, "")
fileN = labInventory & wrdArr(0)
Set wkb = Workbooks.Open(fileN)
Set sht = wkb.Sheets(wrdArr(1))
sht.Activate
Application.ScreenUpdating (False)
For Each c In sht.UsedRange.Cells
If InStr(c.Value, filterS) > 0 And InStr(c.Value, filterS2) > 0 Then
arrCnt = arrCnt + 1
cAddressArr(arrCnt) = c.Address + "" + sht.Name + "" + wkb.Name
End If
Next c
Next ct2
Next ct
Else
For ct = 1 To Results.GetUpperBound(0)
arrCnt = 0
For ct2 = 1 To Results(ct).GetUpperBound(0)
wkbookAndWksheetInfo = Results(ct)(ct2)
wrdArr = Split(wkbookAndWksheetInfo, "")
fileN = labInventory & wrdArr(0)
Set wkb = Workbooks.Open(fileN)
Set sht = wkb.Sheets(wrdArr(1))
sht.Activate
Application.ScreenUpdating (False)
For Each c In sht.UsedRange.Cells
If InStr(c.Value, filterS) > 0 Then
arrCnt = arrCnt + 1
cAddressArr(arrCnt) = c.Address + "" + sht.Name + "" + wkb.Name
End If
Next c
Next ct2
Next ct
End If
FilterResultsEvenFurther = cAddressArr
End Function
'Asks user for input on type of component they need (Examples: resistor, diodes, capacitors etc.)
Private Function GetTypeOfComponent() As String
Dim t As String
t = Application.InputBox(prompt:="Type of Component (Note: Keep the string as only one word an example being resistor, diode etc.):")
GetTypeOfComponent = t
End Function
'filterS
Private Function GetIdentificationOrValueOfComponent() As String
Dim v As String
v = Application.InputBox("Enter value or Identification of Component:")
GetIdentificationOrValueOfComponent = v
End Function
'filterS2
Private Function GetFurtherIdentificationOfComponent() As String
Dim f As String
f = Application.InputBox("Enter any further Identification of Component")
GetFurtherIdentificationOfComponent = f
End Function
'This receives the wkBookList created and attempts to filter it by type of component or something I'm looking for.
Private Function FilterTheFileList(list() As Variant, t As String) As Variant
Dim sht As Worksheet
Dim c As Range
Dim wkBookInfo() As Variant
Dim filteredWkbInfo() As Variant
Dim filteredWksInfo() As Variant
Dim i As Long
Dim wksCnt As Long
Dim wkBookNum As Long
Dim confirmation As String
Dim fileName As String
'Dim workBookInfo As String
Application.ScreenUpdating = False
wkBookNum = list.Length
wksCnt = 1
ReDim filteredWkbInfo(1 To wkBookNum)
For i = 1 To wkBookNum
fileName = "labInventory" & list(wkBookNum)
Workbooks.Open fileName
For Each sht In ActiveWorkbook.Worksheets
For Each c In sht.UsedRange.Rows(1).Cells
If InStr(c.Value, t) > 0 Then
filteredWksInfo(wksCnt) = ActiveWorkbook.Name + "" + sht.Name
wksCnt = wksCnt + 1
End If
Next c
Next sht
filteredWkbInfo(i) = filteredWksInfo
Next i
If IsArray(filteredWkbInfo) Then
ReDim Preserve filteredWkbInfo(1 To wkBookNum)
'workBookInfo = Join(wkBookInfo, vbNullString)
FilterTheFileList = filteredWkbInfo
Else
Application.MsgBox ("There were no matches in any of the workbooks")
End If
End Function
Private Function DisplayResults(cellAddressArr As Variant)
Dim WS As Worksheet
Dim sht As Worksheet
Dim s As String
Dim wArr() As String
Dim Value As String
Dim c As Range
WS.Range("A1") = "Cell location"
Application.ScreenUpdating (False)
For i = 1 To cellAddressArr.Length
s = cellAddressArr(i)
wArr = Split(s, "")
Value = wArr(2)
WS.Hyperlinks.Add Anchor:=WS.Range("A + cellAddressArr.Length"), Address:=labInventory & Value, SubAddress:=wArr(1) & "!" & wArr(0), TextToDisplay:="Link"
Next i
End Function
Sub SearchWkBooks()
Dim wkBookList() As Variant
Dim filteredFileList As Variant
Dim typeOfC As String
Dim filter1 As String
Dim filter2 As String
Dim addressList As Variant
wkBookList = GetFileList()
typeOfC = GetTypeOfComponent()
filter1 = GetIdentificationOrValueOfComponent()
filter2 = GetFurtherIdentificationOfComponent()
filteredFileList = FilterTheFileList(wkBookList, typeOfC)
addressList = FilterResultsEvenFurther(filteredFileList, filter1, filter2)
DisplayResults (addressList)
End Sub
Last edited:
