Best Loop For My VBA Task - vba

Question

I'm really new in VBA coding, currently I have a spreadsheet contains groups and accounts at different levels, following are a simple example:
Group codes are all numbers and Account codes start with 3 letters, say ABC follow by 2 or 3 numbers, so an example would be ABC100, first 2 letter of account codes are always the same, i.e "AB" in the example, so another account code might be ABS80. Group/Account codes are in a separate column corresponding to the groups/accounts.
My aim is to set up a macro which would provide me with a summary, in a separate tab called say results, of all the groups (ONLY) above a given Account/Group in the hierarchy tree, with the subject Account/Group on the bottom.
So to illustrate using the above example. If the subject Account is ABC100, then after running the macro, I would expect to see in the results tab:
So far, I managed to get the macro to find the position of the subject account in the hierarchy and copy that row into the results" tab. But I'm stuck on the next step which is to extract only the direct upper level groups (at the same time ignore the accounts & groups in between) and paste them into the results tab.
I know that I need to use the loop and tried For Next with If Then statement in between, but keeps getting error messages. Really appreciate if someone could lead me to right direction on which loop to use.
Thanks! Below are my current codes:
Sub SearchRelevantAccGp()
'
' This macro finds the account or group and provides a summary of all affected groups
' within the Hierarchy
Dim searchvalue As Variant
searchvalue = Sheets("Dashboard").Range("B2")
Dim hierarchy As Integer
Sheets("Main Tree").Select
cells.Find(What:=searchvalue, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
hierarchy = ActiveCell.Offset(0, 5)
Dim startref As Variant
startref = "I" & ActiveCell.Row
Dim rownumber As Integer
rownumber = ActiveCell.Row
ActiveCell.EntireRow.Select
Selection.Copy
Sheets("Result").Select
Rows(hierarchy).Select
ActiveSheet.Paste
Sheets("Main Tree").Select
Range(startref).Select
For i = rownumber To 2 Step -1
If cells(i - 1, 9).Value - 1 = cells(i, 9).Value And cells(i - 1, 3).Value = "Group" Then
Rows(i).Select
Selection.Copy
Sheets("Result").Select
Rows(hierarchy - 1).Select
ActiveSheet.Paste
End If
Next i
End Sub

Answer 1

Consider no For loop or If logic and simply use SQL which you can in Excel for PC using the Jet/ACE SQL Engine (Windows .dll files). Because your worksheet represents a table we can run various WHERE logic to output to results tab with CopyFromRecordset method:
SQL (embedded below, adjust SheetName and column headers as needed)
SELECT [Type], [Account / Group ID], [Account / Group Name], [Hierarchy Position]
FROM SheetName$
WHERE (([Type] = 'Group' AND [Account / Group Name] NOT LIKE '%dupe%')
OR ([Account / Group ID] = 'ABC100'))
AND ([Hierarchy Position] <= (SELECT Max([Hierarchy Position])
FROM SheetName$ sub
WHERE sub.[Account / Group ID] = 'ABC100'))
VBA (connects to last saved instance of current workbook)
Sub RunSQL()
Dim conn As Object, rs As Object
Dim strConnection As String, strSQL As String
Dim i As Integer
Set conn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
' CONNECTION STRINGS (TWO VERSIONS -ODBC/OLEDB)
strConnection = "DRIVER={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" _
& "DBQ=C:\Path\To\Workbook.xlsm;"
' strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" _
' & "Data Source=C:\Path\To\Workbook.xlsm';" _
' & "Extended Properties=""Excel 12.0 Xml;HDR=YES;"";"
' OPEN DB CONNECTION
conn.Open strConnection
strSQL = "SELECT [Type], [Account / Group ID], [Account / Group Name], [Hierarchy Position]" _
& " FROM SheetName$" _
& " WHERE (([Type] = 'Group' AND [Account / Group Name] NOT LIKE '%dupe%')" _
& " OR ([Account / Group ID] = 'ABC100'))" _
& " AND ([Hierarchy Position] <= (SELECT Max([Hierarchy Position])" _
& " FROM SheetName$ sub" _
& " WHERE sub.[Account / Group ID] = 'ABC100'))"
' OPEN RECORDSET OF SQL RESULTS
rs.Open strSQL, conn
' OUTPUT DATA TO EXISTING SHEET
With ThisWorkbook.Worksheets("results")
' COLUMN HEADERS
For i = 1 To rs.Fields.Count
.Cells(1, i) = rs.Fields(i - 1).Name
Next i
' DATA ROWS
.Range("A2").CopyFromRecordset rs
End With
rs.Close: conn.Close
Set rs = Nothing: Set conn = Nothing
Exit Sub
End Sub

Answer 2

Try this. This used a variant array.
Sub test()
Dim vDB, vR()
Dim Ws As Worksheet, toWs As Worksheet
Dim r As Long, i As Long, n As Long, j As Integer
Set Ws = ActiveSheet
Set toWs = Sheets(2)
vDB = Ws.Range("a1").CurrentRegion
r = UBound(vDB, 1)
For i = 2 To r
If InStr(vDB(i, 3), "Group Level") Or vDB(i, 1) = "ABC100" Then
n = n + 1
ReDim Preserve vR(1 To 4, 1 To n)
For j = 1 To 4
vR(j, n) = vDB(i, j)
Next j
End If
Next i
With toWs
.UsedRange.Clear
.Range("a1").Resize(1, 4) = Ws.Range("a1").Resize(1, 4).Value
.Range("a2").Resize(n, 4) = WorksheetFunction.Transpose(vR)
.Columns.AutoFit
End With
End Sub

Answer 3

This traverses the hierarchy backwards in "Results" which is a full copy of worksheet "Dashboard"
Hides all rows, then unhides each relevant row, to avoid copying and pasting data
Option Explicit
Public Sub ShowHierarchy()
Dim ws As Worksheet, found As Range, r As Long, nextR As Long
Set ws = ThisWorkbook.Worksheets("Results")
Set found = ws.UsedRange.Columns(2).Find(What:="ABC10", LookAt:=xlWhole)
If Not found Is Nothing Then 'ABC100 was found so we continue
ws.UsedRange.EntireRow.Hidden = True 'hide all rows on Results sheet
r = found.Row: nextR = -1 'get found row, and move up to next row
If r > 1 Then 'make sure it wasn't found on row 1
ws.Rows(1).Hidden = False 'unhide header row
ws.Cells(1).Activate 'update display (scroll to top row)
found.EntireRow.Hidden = False 'unhide found row
Dim foundLvl As Long, nextLvl As Long, lvlRng As Range
foundLvl = Val(found.Offset(0, 2)) 'get current level from column D
nextLvl = foundLvl 'establish initial (minimum) level
Application.ScreenUpdating = False 'turn off display
While nextLvl > 1 'loop while level is greater than 1
Set lvlRng = found.Offset(nextR, 2) 'get next level from column D
If Not IsError(lvlRng) Then 'check for errors (#N/A, #DIV/0!, etc)
nextLvl = Val(lvlRng) 'set next level
If nextLvl < foundLvl Then 'compare levels
If LCase(lvlRng.Offset(0, -3)) = "group" Then 'check Group in Col A
foundLvl = nextLvl 'set next minimum levele
lvlRng.EntireRow.Hidden = False
End If
End If
End If
nextR = nextR - 1 'move up to the next row, and repeat
Wend
Application.ScreenUpdating = True 'turn display back on
End If
End If
End Sub
Before
After