Looping VBA Query

Hello,

Basically I have the following VBA queries that bring some data from some .dbf files into Excel

What I’m looking to do (If possible) is align the 3rd query (CBARTOT) with the second query (CBARSUM), this itself is very easy and not a problem, then based on the value in the first column of CBARSUM (A23) sum all the columns in CBARTOT and then loop down using the value in A24 and so on until there are no more values in the A column. Now CBARSUM could contain any number between 1 & 10 records as this query updates to a variety of different CBARSUM dbf files.

I’ve attached a test workbook if that helps

Sub Controller()
'

'

    
    Dim Mailbox As String
    Dim create As Boolean
    Dim sConn As String
    Dim sSql As String
    Dim oQt As QueryTable
    Dim r As Long
    Dim StartDate As String
    Dim j(1 To 21) As Boolean
    Dim k As Integer

    Dim LastRow As Long
    create = True

  If create Then
    
    Mailbox = ActiveWorkbook.Path
  
    
ActiveWorkbook.Sheets("Sheet1").Select
Range("B4:AI40,A65:D86,AK4:AR277,AT4:BC236,h63,L63,bu1:bv3").ClearContents
   
  
    
    
 ' Cresult Data
 
   sConn = "ODBC;CollatingSequence=ASCII;DBQ=C:\TEMP;DefaultDir=C:\TEMP;Deleted=1;Driver={Microsoft dBase Driver (*.dbf)};DriverId=533;FIL=dBase;"
   sSql = "SELECT * FROM """ & Mailbox & """\CRESULT.DBF CRESULT"
   Set oQt = ActiveSheet.QueryTables.Add(Connection:=sConn, Destination:=Range("A1"), Sql:=sSql)
    oQt.AdjustColumnWidth = False
    oQt.PreserveFormatting = True
    oQt.RefreshStyle = xlOverwriteCells
    oQt.Refresh
    
    'CBarSum
    
    sConn = "ODBC;CollatingSequence=ASCII;DBQ=C:\TEMP;DefaultDir=C:\TEMP;Deleted=1;Driver={Microsoft dBase Driver (*.dbf)};DriverId=533;FIL=dBase;"
   sSql = "SELECT CODE, NAME, TYPE FROM """ & Mailbox & """\CBARSUM.DBF CBARSUM WHERE (CBARSUM.TYPE='RETAIL')"
   Set oQt = ActiveSheet.QueryTables.Add(Connection:=sConn, Destination:=Range("A22"), Sql:=sSql)
    oQt.AdjustColumnWidth = False
    oQt.PreserveFormatting = True
    oQt.RefreshStyle = xlOverwriteCells
    oQt.Refresh
    
    'CBarTot
    
    sConn = "ODBC;CollatingSequence=ASCII;DBQ=C:\TEMP;DefaultDir=C:\TEMP;Deleted=1;Driver={Microsoft dBase Driver (*.dbf)};DriverId=533;FIL=dBase;"
   sSql = "SELECT * FROM """ & Mailbox & """\CBARTOT.DBF CBARTOT"
   Set oQt = ActiveSheet.QueryTables.Add(Connection:=sConn, Destination:=Range("A40"), Sql:=sSql)
    oQt.AdjustColumnWidth = False
    oQt.PreserveFormatting = True
    oQt.RefreshStyle = xlOverwriteCells
    oQt.Refresh
    
    
End If
    

    
End Sub

Many Thanks