How to do a nested search based on multiple tab dependent values? - excel

Question

I have three worksheets, Accounts, JEExtracts & Detail Extracts.
I would like to search based on values from Accounts WS which is unique and find all matches from JEExtracts, then based on all matching values found, take values of another cell corresponding to that row and search all instances from Detail extracts WS.
When I do that, the first iteration works. In the second iteration the searchstring loses its value. It ends in error object not defined.
Sub FilterAccount()
Dim c As Range
Dim searchRng As Range
Dim searchRng2 As Range
Dim LastAcc As Long
Dim LastRowJE As Long
Dim LastRowDE As Long
Dim fAddress
Dim fAddress2
LastAcc = Sheets("Accounts").Cells(2, 1).End(xlDown).Row
LastRowJE = Sheets("JournalExtract").Cells(2, 2).End(xlDown).Row
LastRowDE = Sheets("DetailExtract").Cells(2, 10).End(xlDown).Row
LastAcc = LastAcc - 1
LastRowJE = LastRowJE - 1
LastRowDE = LastRowDE - 1
ACRow = 2
ACCol = 1
JERow = 2
JECol = 7
DERow = 2
DECol = 10
Worksheets("Accounts").Activate
Application.ScreenUpdating = False
'Loop through cells to do the lookup based on value on a particular column of worksheet Accounts
For Each c In Sheets("Accounts").Range(Cells(ACRow, ACCol), Cells(LastAcc, ACCol))
'MsgBox (c.Value)
If IsEmpty(c) = True Then Exit For 'If there is no value found in the cell then exit from the process
If IsEmpty(c) = False Then 'If there is value found in the cell then search the same value in JournalExtract
Worksheets("JournalExtract").Activate
With Sheets("JournalExtract").Range(Cells(JERow, JECol), Cells(LastRowJE, JECol)) 'Using the cells looking up resource name in pivot tab
Set searchRng = .Find(What:=c.Value) 'Find it
If Not searchRng Is Nothing Then 'If we find a value
fAddress = searchRng.Address 'Set the address to compare
Do
searchRng.Offset(0, 0).Cells.Interior.Color = RGB(255, 0, 0)
Worksheets("DetailExtract").Activate
'Using the value from worksheet JournalExtract looking up value in DetailExtract
With Sheets("DetailExtract").Range(Cells(DERow, DECol), Cells(LastRowDE, DECol))
Set searchRng2 = .Find(What:=searchRng.Offset(0, 4)) 'Find it
If Not searchRng2 Is Nothing Then
fAddress2 = searchRng2.Address
Do
searchRng2.Offset(0, 0).Cells.Interior.Color = RGB(255, 255, 0)
Set searchRng2 = .FindNext(searchRng2)
Loop While Not searchRng2 Is Nothing And searchRng2.Address <> fAddress2
End If
Set searchRng2 = Nothing
End With
Worksheets("JournalExtract").Activate
Set searchRng = .FindNext(searchRng) 'Doesn't get value in 2nd iteration
Loop While Not searchRng Is Nothing And searchRng.Address <> fAddress 'Here error is thrown - Object value not set.
End If
End With
End If
Set searchRng = Nothing
Next
Application.ScreenUpdating = True
End Sub

Answer 1

A Find/FindNext pair can only be used one at a time. If you try a nested Find/FindNext using the value from the first Find/FindNext, the first is removed and replaced by the second. You need an alternative method of location for the nested lookup or you can isolate each process.
This is hopefully closer to what you need but I didn't fully test it. It builds a union from the results of the first Find/FindNext pair then cycles through that union of ranges to process the second Find/FindNext pair.
Option Explicit
Sub FilterAccount()
Dim c As Range, s As Range
Dim searchRng As Range, foundRng As Range
Dim searchRng2 As Range
Dim LastAcc As Long, LastRowJE As Long, LastRowDE As Long
Dim ACRow As Long, ACCol As Long, JERow As Long, JECol As Long, DERow As Long, DECol As Long
Dim fAddress As String, fAddress2 As String
LastAcc = Worksheets("Accounts").Cells(Rows.Count, "A").End(xlUp).Row - 1
LastRowJE = Worksheets("JournalExtract").Cells(Rows.Count, "B").End(xlUp).Row - 1
LastRowDE = Worksheets("DetailExtract").Cells(Rows.Count, "J").End(xlUp).Row - 1
ACRow = 2
ACCol = 1
JERow = 2
JECol = 7
DERow = 2
DECol = 10
With Worksheets("Accounts")
'Loop through cells to do the lookup based on value on a particular column of worksheet Accounts
For Each c In .Range(.Cells(ACRow, ACCol), .Cells(LastAcc, ACCol))
'If there is no value found in the cell then exit from the process
If IsEmpty(c) Then
Exit For
Else
With Worksheets("JournalExtract")
'Using the cells looking up resource name in pivot tab
With .Range(.Cells(JERow, JECol), .Cells(LastRowJE, JECol))
Set searchRng = .Find(What:=c.Value) 'Find it
'If we find a value
If Not searchRng Is Nothing Then
fAddress = searchRng.Address 'Set the address to compare
Set foundRng = searchRng
'collect all the searchRngs into a union
Do
Set foundRng = Union(foundRng, searchRng)
Set searchRng = .FindNext(after:=searchRng)
Loop While searchRng.Address <> fAddress
foundRng.Cells.Interior.Color = RGB(255, 0, 0)
'now on to the second search
'cycle through the union
For Each s In foundRng
With Worksheets("DetailExtract")
'Using the value from worksheet JournalExtract looking up value in DetailExtract
With .Range(.Cells(DERow, DECol), .Cells(LastRowDE, DECol))
Set searchRng2 = .Find(What:=c.Offset(0, 4)) 'Find it
If Not searchRng2 Is Nothing Then
fAddress2 = searchRng2.Address
Do
searchRng2.Offset(0, 0).Cells.Interior.Color = RGB(255, 255, 0)
Set searchRng2 = .FindNext(searchRng2)
Loop While searchRng2.Address <> fAddress2
End If
End With
End With
Next s
End If
End With
End With
End If
Next c
End With
End Sub

Answer 2

You can use SQL to query your data. Note that I changed Accounts to Account. Sample workbook.
Sub FindValues()
Dim c%, sql$, conn_string$
Dim rs As Object
Dim wksOutput As Worksheet
conn_string = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & ThisWorkbook.FullName & ";" & _
"Extended Properties=""Excel 12.0"";"
Set rs = CreateObject("ADODB.Recordset")
rs.CursorLocation = adUseClient
sql$ = "SELECT A.Account, J.[Link ID], DE.[Values] " & _
"FROM ([Accounts$] AS A " & _
"INNER JOIN [JEExtracts$] AS J " & _
"ON A.Account = J.Account) " & _
"INNER JOIN ['Detail Extracts$'] AS DE " & _
"ON J.[Link ID] = DE.[Link ID];"
rs.Open sql, conn_string, adOpenForwardOnly, adLockReadOnly
If rs.RecordCount > 0 Then
Set wksOutput = Sheets.Add(After:=Sheets(Sheets.Count))
wksOutput.Name = "output"
With wksOutput
'// Output headers
For c = 0 To rs.Fields.Count - 1
.Cells(1, c + 1) = rs.Fields(c).Name
Next
.Range("A2").CopyFromRecordset rs
End With
Else
MsgBox "No records were found.", vbExclamation
End If
rs.Close
Set rs = Nothing
End Sub