horizontal loops or another solution

[tourless]

Hi Folks,

I've got an issue trying to figure out how to loop across horizontal parameters for multiple iterations.

My requirement is to build a report that sums revenue by week for only the first 13 weeks period for any customers that started on or after 2018-01-01. I have a simply msquery which returns the list of customers and their start dates (col A & B), then I work out the details for start and stop dates for the first 13 weeks for each customer across the row (col C - AB).

I created an ADODB connection and can pass my complex sql query with start and end date parameters (with plans of adding a parameter for customer name), then I'm stuck. I can't figure out, or wrap my head around calling the query for each customer and each set of dates (col C/D, E/F, G/H, etc) to report back the weekly revenue for each week, as a horizontal list. My end result should be a single worksheet containing each customer name in col A and their weekly revenue for their specific first 13 weeks of service, spread across columns B - N. In my GetSQLString function you can see my attempt at pulling the start and end dates from my worksheet (hardcoded to test).

Option Explicit

Const ConStrSQL As String = "Provider=SQLNCLI11;Server=NSLSQL;Database=NSL_LM;Trusted_Connection=yes;"

Sub Refresh() 'Clear previous queries and results sets
    Dim DataSh, ResultsSh As Worksheet
        
    With Application
        .DisplayAlerts = False
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    
    'Refresh the query sheets
    For Each DataSh In Sheets(Array("DP-Customers"))
        DataSh.Select
        Rows.Hidden = False
            With ActiveSheet
                .Rows("2:" & .Rows.Count).Select
                Selection.ClearContents
            End With
        Range("A1").Select
        Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
    Next
    
    CalculateDates
    
End Sub
    
    Sub CalculateDates()
        
    Dim lRow As Long

    lRow = LastRow(wsDPCustomers)
    
    wsDPCustomers.Range("C2:C" & lRow).Formula = "=B2 -WEEKDAY(TODAY(),3)"
    wsDPCustomers.Range("D2:D" & lRow).Formula = "=C2+6"
    wsDPCustomers.Range("E2:E" & lRow).Formula = "=D2+1"
    wsDPCustomers.Range("F2:F" & lRow).Formula = "=E2+6"
    wsDPCustomers.Range("G2:G" & lRow).Formula = "=F2+1"
    wsDPCustomers.Range("H2:H" & lRow).Formula = "=G2+6"
    wsDPCustomers.Range("I2:I" & lRow).Formula = "=H2+1"
    wsDPCustomers.Range("J2:J" & lRow).Formula = "=I2+6"
    wsDPCustomers.Range("K2:K" & lRow).Formula = "=J2+1"
    wsDPCustomers.Range("L2:L" & lRow).Formula = "=K2+6"
    wsDPCustomers.Range("M2:M" & lRow).Formula = "=L2+1"
    wsDPCustomers.Range("N2:N" & lRow).Formula = "=M2+6"
    wsDPCustomers.Range("O2:O" & lRow).Formula = "=N2+1"
    wsDPCustomers.Range("P2:P" & lRow).Formula = "=O2+6"
    wsDPCustomers.Range("Q2:Q" & lRow).Formula = "=P2+1"
    wsDPCustomers.Range("R2:R" & lRow).Formula = "=Q2+6"
    wsDPCustomers.Range("S2:S" & lRow).Formula = "=R2+1"
    wsDPCustomers.Range("T2:T" & lRow).Formula = "=S2+6"
    wsDPCustomers.Range("U2:U" & lRow).Formula = "=T2+1"
    wsDPCustomers.Range("V2:V" & lRow).Formula = "=U2+6"
    wsDPCustomers.Range("W2:W" & lRow).Formula = "=V2+1"
    wsDPCustomers.Range("X2:X" & lRow).Formula = "=W2+6"
    wsDPCustomers.Range("Y2:Y" & lRow).Formula = "=X2+1"
    wsDPCustomers.Range("Z2:Z" & lRow).Formula = "=Y2+6"
    wsDPCustomers.Range("AA2:AA" & lRow).Formula = "=Z2+1"
    wsDPCustomers.Range("AB2:AB" & lRow).Formula = "=AA2+6"
    
    wsDPCustomers.Range("A1").CurrentRegion.EntireColumn.AutoFit
    wsDPCustomers.Range("A1").Select
    
    CopyDataFromDatabaseEarlyBinding

End Sub

Sub CopyDataFromDatabaseEarlyBinding()
    
    Dim LMConn As ADODB.Connection
    Dim LMData As ADODB.Recordset
    Dim LMField As ADODB.Field
    
    Set LMConn = New ADODB.Connection
    Set LMData = New ADODB.Recordset
    
    LMConn.ConnectionString = ConStrSQL
    LMConn.Open
    
    On Error GoTo CloseConnection
    
    With LMData
        .ActiveConnection = LMConn
        .Source = GetSQLString
        .LockType = adLockReadOnly
        .CursorType = adOpenForwardOnly
        .Open
    End With
    
    On Error GoTo CloseRecordSet
    Worksheets.Add
    
    For Each LMField In LMData.Fields
        ActiveCell.Value = LMField.Name
        ActiveCell.Offset(0, 1).Select
    Next LMField
    
    Range("A1").Select
    Range("A2").CopyFromRecordset LMData
    Range("A1").CurrentRegion.EntireColumn.AutoFit
    
    On Error GoTo 0
    
CloseRecordSet:
    LMData.Close
    
CloseConnection:
    LMConn.Close
    
End Sub
Sub CopyDataFromDatabaseLateBinding()
    
    Dim LMConn As Object
    Dim LMData As Object
    Dim LMField As Object
    
    Set LMConn = CreateObject("ADODB.Connection")
    Set LMData = CreateObject("ADODB.Recordset")
    
    LMConn.ConnectionString = ConStrSQL
    LMConn.Open
    
    On Error GoTo CloseConnection
    
    With LMData
        .ActiveConnection = LMConn
        .Source = "SELECT LMCustomer.Name FROM LMCustomer" & _
        " & ""WHERE Nact = 0"
        .LockType = 1
        .CursorType = 0
        .Open
    End With
    
    On Error GoTo CloseRecordSet
    
    Worksheets.Add
    
    For Each LMField In LMData.Fields
        ActiveCell.Value = LMField.Name
        ActiveCell.Offset(0, 1).Select
    Next LMField
    
    Range("A1").Select
    Range("A2").CopyFromRecordset LMData
    Range("A1").CurrentRegion.EntireColumn.AutoFit
    
    On Error GoTo 0
    
CloseRecordSet:
    LMData.Close
    
CloseConnection:
    LMConn.Close
    
End Sub

Function LastRow(targetSheet As Worksheet, Optional targetCol As String = "A")

    With targetSheet
        LastRow = .Cells(.Rows.Count, targetCol).End(xlUp).Row
    End With
    
End Function

Function GetSQLString() As String
    
    Dim startDate As String, endDate As String
    Dim sqlString As String
    
'    startDate = wsDPCustomers.Range("C2").Value
'    endDate = wsDPCustomers.Range("D2").Value
    startDate = "'2018-06-18'"
    endDate = "'2018-06-24'"
    
    sqlString = "SELECT LMCustomer.Name " & _
        ",Sum(LMDelivery.LDRYCENSCHRG+LMDelivery.LDRYWGHTCHRG+LMDelivery.LDRYPIECCHRG-LMDelivery.RETNWGHTCRED " & _
        "-LMDelivery.RETNPIECCRED-LMDelivery.VRNCCHRG+LMDelivery.LDRYDELVCHRG+LMDelivery.PRCHCHRG+LMDelivery.LDRYPCNTCHRG " & _
        "+LMDelivery.AUXPCHRG01+LMDelivery.AUXPCHRG02+LMDelivery.AUXPCHRG03+LMDelivery.AUXPCHRG04+LMDelivery.AUXPCHRG05+LMDelivery.AUXPCHRG06 " & _
        "+LMDelivery.AUXPCHRG07+LMDelivery.AUXPCHRG08+LMDelivery.AUXPCHRG09+LMDelivery.AUXPCHRG10+LMDelivery.AUXPCHRG11+LMDelivery.AUXPCHRG12 " & _
        "-LMDelivery.AUXPCRED01-LMDelivery.AUXPCRED02-LMDelivery.AUXPCRED03-LMDelivery.AUXPCRED04-LMDelivery.AUXPCRED05-LMDelivery.AUXPCRED06 " & _
        "-LMDelivery.AUXPCRED07-LMDelivery.AUXPCRED08-LMDelivery.AUXPCRED09-LMDelivery.AUXPCRED10-LMDelivery.AUXPCRED11-LMDelivery.AUXPCRED12 " & _
        "+LMDelivery.AUXMCHRG01+LMDelivery.AUXMCHRG02+LMDelivery.AUXMCHRG03+LMDelivery.AUXMCHRG04+LMDelivery.AUXMCHRG05+LMDelivery.AUXMCHRG06 " & _
        "+LMDelivery.AUXMCHRG07+LMDelivery.AUXMCHRG08-LMDelivery.AUXMCRED01-LMDelivery.AUXMCRED02-LMDelivery.AUXMCRED03-LMDelivery.AUXMCRED04 " & _
        "-LMDelivery.AUXMCRED05-LMDelivery.AUXMCRED06-LMDelivery.AUXMCRED07-LMDelivery.AUXMCRED08) AS Revenue " & _
        "FROM LMDelivery " & _
        "JOIN LMCustomer ON LMDelivery.ShipCustRcID = LMCustomer.RcID " & _
        "WHERE (LMDelivery.LdryDelvDate BETWEEN " & startDate & "  AND " & endDate & ") AND (LMDelivery.UsefCanc = 0) " & _
        "GROUP BY LMCustomer.RcID, LMCustomer.Name"

    GetSQLString = sqlString
End Function

 

[tourless]

Well I found a solution. Which is completely sideways from my original intent but solves my problem more gracefully. The ADODB was good practice but not needed. I creaed a vew in SQL and pull that into excel. Here's my solution...

SELECT        dbo.LMCustomer.Name, 
                         SUM(dbo.LMDelivery.LdryCensChrg + dbo.LMDelivery.LdryWghtChrg + dbo.LMDelivery.LdryPiecChrg - dbo.LMDelivery.RetnWghtCred - dbo.LMDelivery.RetnPiecCred - dbo.LMDelivery.VrncChrg + dbo.LMDelivery.LdryDelvChrg +
                          dbo.LMDelivery.PrchChrg + dbo.LMDelivery.LdryPcntChrg + dbo.LMDelivery.AuxpChrg01 + dbo.LMDelivery.AuxpChrg02 + dbo.LMDelivery.AuxpChrg03 + dbo.LMDelivery.AuxpChrg04 + dbo.LMDelivery.AuxpChrg05 + dbo.LMDelivery.AuxpChrg06
                          + dbo.LMDelivery.AuxpChrg07 + dbo.LMDelivery.AuxpChrg08 + dbo.LMDelivery.AuxpChrg09 + dbo.LMDelivery.AuxpChrg10 + dbo.LMDelivery.AuxpChrg11 + dbo.LMDelivery.AuxpChrg12 - dbo.LMDelivery.AuxpCred01 - dbo.LMDelivery.AuxpCred02
                          - dbo.LMDelivery.AuxpCred03 - dbo.LMDelivery.AuxpCred04 - dbo.LMDelivery.AuxpCred05 - dbo.LMDelivery.AuxpCred06 - dbo.LMDelivery.AuxpCred07 - dbo.LMDelivery.AuxpCred08 - dbo.LMDelivery.AuxpCred09 - dbo.LMDelivery.AuxpCred10
                          - dbo.LMDelivery.AuxpCred11 - dbo.LMDelivery.AuxpCred12 + dbo.LMDelivery.AuxmChrg01 + dbo.LMDelivery.AuxmChrg02 + dbo.LMDelivery.AuxmChrg03 + dbo.LMDelivery.AuxmChrg04 + dbo.LMDelivery.AuxmChrg05 + dbo.LMDelivery.AuxmChrg06
                          + dbo.LMDelivery.AuxmChrg07 + dbo.LMDelivery.AuxmChrg08 - dbo.LMDelivery.AuxmCred01 - dbo.LMDelivery.AuxmCred02 - dbo.LMDelivery.AuxmCred03 - dbo.LMDelivery.AuxmCred04 - dbo.LMDelivery.AuxmCred05 - dbo.LMDelivery.AuxmCred06
                          - dbo.LMDelivery.AuxmCred07 - dbo.LMDelivery.AuxmCred08) AS Revenue
FROM            dbo.LMDelivery INNER JOIN
                         dbo.LMCustomer ON dbo.LMDelivery.ShipCustRcID = dbo.LMCustomer.RcID INNER JOIN
                         dbo.LMContract ON dbo.LMDelivery.ContRcID = dbo.LMContract.RcID
WHERE        (dbo.LMDelivery.UsefCanc = 0) AND (dbo.LMContract.StrtDate >= '2018-01-01') AND (dbo.LMDelivery.LdryDelvDate >= '2018-01-01')
GROUP BY dbo.LMCustomer.RcID, dbo.LMCustomer.Name, DATEPART(week, dbo.LMDelivery.LdryDelvDate)