Excel Forum

Code: Select all

Sub CreateRegionalReport()
    Dim Crs As ADODB.Recordset
    Dim cn As ADODB.Connection
    Dim constr As String
    Const RptSheet = "North,Central,South,East,NE,Project"
    Dim Regional() As String
    Dim s As Long
    Regional() = Split(RptSheet, ",")
    Dim SQL$
    
    constr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ActiveWorkbook.Path & "\" & ActiveWorkbook.Name & ";Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
    Set cn = New ADODB.Connection
    cn.Open constr
    
    For s = 0 To UBound(Regional, 1)
    Worksheets("Detail").Activate
    Set Crs = New ADODB.Recordset
    SQL = "SELECT [No],[Date],[Sale Name],[Regional], [Quote], [Confirm], [Type],[CarRegis],[PolicyDate] " & _
            " FROM " & Range("A3:I58").Address(0, 0) & " WHERE [Regional] = '" & Regional(s) & "';"
    Crs.Open SQL, cn, adOpenForwardOnly, adLockReadOnly
    
    If Crs.EOF = False Then
    With ThisWorkbook
    .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = Regional(s)
    Worksheets(Regional(s)).Activate
    Range("A4").CopyFromRecordset Crs

    End With
    End If
    Crs.Close
    
    Next s
    
    cn.Close
    Set Crs = Nothing
    Set cn = Nothing
    
End Sub

Code: Select all

SQL = "SELECT * " & _
 " FROM " & Range("A3:I58").Address(0, 0) & " WHERE [Regional] = '" & Regional(s) & "';"

Code: Select all

SQL = " SELECT * from " & _
" FROM " & Range("A3:I58").Address(0, 0) & " WHERE F4 = '" & Regional(s) & "';"