I am looking for a function that takes two input arguments, boardtype and subsysnum and then finds the row index that has that specific combination. However, if subsysnum column is blank then continue on. Only some cases will have a subsysnum value. boardtype will have to be an exact match. For the purpose of the function, I have written so far, boardtype and subsysnum are defined both as strings above. column defined when calling the function will be either 3 or 5
I have so far called the worksheet that has the lookup table in it and believe I have found the row index for the boardtype now I just need to incorporate if subsysnum value can be found in the second column then find the row combination index, else continue with the blank second column to find the lookup value. This is what my data looks like
Using the table above say for example my boardtype = AX-6 and my subsysnum = WD1234TEST I want the macro to get the row index of 9 since subsysnum = WD1234 is contained in the subsysnum number WD1234TEST. If subsysnum = WD298588 trial, then the row index return should be 8 since it is contained in the value. Finally, if subsysnum value cannot be found in column 2, then it should return a row index of 7 for AX-6 with the blank cell next to it.
This is what I have tried so far, however, I am not getting any value for GetClock
Function GetClock(boardtype As String, subsysnum As String, column As Long, Optional partialFirst As Boolean = False) As Variant
Dim wbSrc As Workbook, ws As Worksheet, r1 As Range, r2 As Range, board_range As Range, firstAddress As String
FunctionName = "GetClock"
Set wbSrc = Workbooks.Open("C:\Documents\LookupTable.xlsx")
Set ws = wbSrc.Worksheets("Clock")
Set r1 = ws.Columns(1)
Set r2 = ws.Columns(2)
With r1
Set board_range = r1.Find(What:=boardtype, LookAt:=xlWhole, LookIn:=xlFormulas, MatchCase:=True) ' find board type row
If Not board_range Is Nothing Then
firstAddress = board_range.Address ' save board type address
Else
ErrorMsg = ErrorMsg & IIf(ErrorMsg = "", "", "") & SectionName & ": " & "Board " & boardtype & " could not be found in lookup table" & vbNewLine
Exit Function
End If
Do While Not board_range Is Nothing
Set subsysnum_range = r2.Find(What:=subsysnum, LookIn:=xlFormulas, LookAt:=IIf(partialFirst, xlPart, xlWhole), MatchCase:=True)
GetClock = ws.cells(board_range.row, column).value
Exit Function
Set board_range = r1.Find(boardtype, board_range)
If board_range.Address = firstAddress Then
GetClock = ws.cells(Range(firstAddress).row, column).value
If GetClock = 0 Then
ErrorMsg = ErrorMsg & IIf(ErrorMsg = "", "", "") & SectionName & ": " & "lookup table missing value" & vbNewLine
End If
Exit Function
End If
Loop
End With
End Function
UPDATE: Where Column(13) represents the column in the Data Sheet that has the subsysnum stored
Function GetClock(boardtype As String, subsysnum As String, column As Long, Optional partialFirst As Boolean = False) As Double
Dim wbSrc As Workbook, ws As Worksheet, r1 As Range, r2 As Range, board_range As Range, firstAddress As String, subsysnum_range As Range, rng_board As Range, rng_subsys As Range
FunctionName = "GetExternalClock"
Set wbSrc = Workbooks.Open("C:\Documents\LookupTable.xlsx")
Set ws = wbSrc.Worksheets("Clock")
Dim wb As Workbook, dataws As Worksheet
Set wb = Workbooks("S93.xlsm")
Set dataws = wb.Worksheets("Data Sheet")
Set r1 = ws.Columns(1)
Set r2 = ws.Columns(2)
With r1
Set board_range = r1.Find(What:=boardtype, LookAt:=xlWhole, LookIn:=xlFormulas, MatchCase:=True) ' find board type row
If Not board_range Is Nothing Then
firstAddress = board_range.Address ' save board type address
Else
ErrorMsg = ErrorMsg & IIf(ErrorMsg = "", "", "") & SectionName & ": " & "Board " & boardtype & " could not be found in lookup table" & vbNewLine
Exit Function
End If
Dim subsys As Range, cell As String
Do While Not board_range Is Nothing ' while board type is not nothing look for value of cell in column 2
For Each subsys In Range("B3:B12")
cell = subsys.value
Set subsys_rng = dataws.Columns(13).Find(What:=cell, LookIn:=xlFormulas, LookAt:=IIf(partialFirst, xlPart, xlWhole), MatchCase:=True)
If cell = "" Then
GoTo Skip
Else
GetClock= ws.cells(subsys_rng.row, column).value
End If
Skip:
Next subsys
Exit Function
'if intersect.value does not equal sysnum, then it will set board_range below only after it has checked every matching cell in column 1
Set board_range = r1.Find(boardtype, board_range)
If board_range.Address = firstAddress Then
GetClock= ws.cells(Range(firstAddress).row, column).value ' boardtype row index with empty cell in r2
If GetClock= 0 Then
ErrorMsg = ErrorMsg & IIf(ErrorMsg = "", "", "") & SectionName & ": " & "lookup table missing value" & vbNewLine
End If
Exit Function
End If
Loop
End With
Exit Function
End Function
CodePudding user response：
Please, check the next function:
Function GetClock(wbSrc As Workbook, boardtype As String, subsysnum As String, Optional column As Long = 0) As Long
Dim ws As Worksheet, lastR As Long, arr, i As Long, dict As Object
Set ws = wbSrc.Worksheets("Clock")
lastR = ws.Range("A" & ws.rows.count).End(xlUp).row
arr = ws.Range("A2:F" & lastR).Value2
Set dict = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(arr)
If arr(i, 1) = boardtype And InStr(arr(i, 2), subsysnum) > 0 Then
If column = 0 Then
dict(1) = i 1
Else
dict(1) = arr(i, column)
End If
ElseIf arr(i, 1) = boardtype Then
If column = 0 Then
dict(2) = i 1
Else
dict(2) = arr(i, column)
End If
End If
Next i
If dict.Exists(1) Then
GetClock = dict(1)
ElseIf dict.Exists(2) Then
GetClock = dict(2)
End If
End Function
It can be tested being called as:
Sub testGetClock()
Dim wbSrc As Workbook
On Error Resume Next
Set wbSrc = Workbooks("LookupTable.xlsx")
On Error GoTo 0
If wbSrc Is Nothing Then Set wbSrc = Workbooks.Open("C:\Documents\LookupTable.xlsx")
Debug.Print GetClock("AX-6", "WD298588")
Debug.Print GetClock("AX-6", "WD1234")
Debug.Print GetClock("AX-6", "WD1234", 3)
End Sub
If you use the column parameter and the returned value may be a string the function return have to be changed from Long to Variant...
Now, in case of no match it returns zero (0).
Please, send some feedback after testing it
CodePudding user response：
A simple loop over an array would be easier to manage, along with caching the lookup table between calls:
Function GetClock(boardtype As String, subsysnum As String, column As Long, _
Optional partialSubSys As Boolean = False) As Variant
Static data As Variant
Dim r As Long, rNoSub As Long, rMatchSub As Long, rMatch As Long, wldCard As String
If IsEmpty(data) Then 'data not already cached?
With Workbooks.Open("C:\Documents\LookupTable.xlsx")
data = .Worksheets("Clock").Range("A1").CurrentRegion.Value
.Close False
End With
End If
wldCard = IIf(partialSubSys, "*", "") 'using a wildcard?
For r = 2 To UBound(data, 1)
If data(r, 1) = boardtype Then
If Len(data(r, 2)) = 0 And rNoSub = 0 Then
rNoSub = r 'first matched line with no subsystem listed
ElseIf subsysnum Like data(r, 2) & wldCard Then '<<FIXED
rMatchSub = r 'subsystem matched
Exit For 'stop checking
End If
End If
Next r
rMatch = IIf(rMatchSub > 0, rMatchSub, rNoSub) 'prefer two-part match...
If rMatch > 0 Then 'any match (one- or two-part) ?
GetClock = data(rMatch, column)
Else
GetClock = CVErr(xlErrNA)
'populate error message as needed
End If
End Function