Hello,
I have the following code:
Sub VBF()
'
' VBF Macro
'
Dim strSQL As String
strSQL = "select count(distinct contact_number)" & vbNewLine _
& "from contact_categories" & vbNewLine _
& "where activity = 'SUPP'" & vbNewLine _
& "and activity_value in ('HLEG','HL','HLU')" & vbNewLine _
& "and valid_from between '01-Nov-2009' and '30-Nov-2009'"
Call AddList("MH4L", "zMH4L", strSQL)
strSQL = "select count(distinct contact_number)" & vbNewLine _
& "from contact_categories" & vbNewLine _
& "where activity = 'SUPP'" & vbNewLine _
& "and activity_value in ('HLEG','HL','HLU')" & vbNewLine _
& "and valid_from <= '30-Nov-2009'" & vbNewLine _
& "and valid_to >= '30-Nov-2009'"
Call AddList("Total H4L", "zTH4L", strSQL)
strSQL = "select count(distinct contact_number)" & vbNewLine _
& "from contact_categories" & vbNewLine _
& "where activity = 'SUPP'" & vbNewLine _
& "and activity_value in ('LEG','PLG')" & vbNewLine _
& "and valid_from between '01-Nov-2009' and '30-Nov-2009'"
Call AddList("MLP", "zMLP", strSQL)
End Sub
Sub AddList(pstrSheetName As String, pstrConnectionName As String, pstrSQL As String)
Dim arrConn As Variant
arrConn = Array(Array("ODBC;DSN=CONTLIVE3;UID=xxx;;DBQ=CONTLIVE3;DBA=W;APA=T;EXC=F;FEN=T;QTO=T;FRC=10;FDL=10;LOB=T;RST=T;BTD=F;BNF=F;BAM=IfAllSuccessful"), _
Array(";NUM=NLS;DPM=F;MTS=F;MDI=F;CSR=F;FWC=F;FBS=60000;TLO=0;"))
Sheets(pstrSheetName).Select
With ActiveWorkbook.Connections(pstrConnectionName).ODBCConnection
.BackgroundQuery = True
.CommandText = pstrSQL
.CommandType = xlCmdSql
.Connection = arrConn
.RefreshOnFileOpen = True
.SavePassword = False
.SourceConnectionFile = ""
.SourceDataFile = ""
.ServerCredentialsMethod = xlCredentialsMethodIntegrated
.AlwaysUseConnectionFile = False
End With
With ActiveWorkbook.Connections(pstrConnectionName)
.Name = pstrConnectionName
.Description = ""
End With
Do While Sheets(pstrSheetName).ListObjects.Count > 0
Sheets(pstrSheetName).ListObjects.Remove 0
Loop
With Sheets(pstrSheetName).ListObjects.Add(SourceType:=0, Source:=arrConn, _
Destination:=Sheets(pstrSheetName).Range("$A$1")).QueryTable
.CommandText = pstrSQL
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = True
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Table_" & pstrConnectionName
.Refresh BackgroundQuery:=False
End With
End Sub
It seems to be erroring on:
Do While Sheets(pstrSheetName).ListObjects.Count > 0
Sheets(pstrSheetName).ListObjects.Remove 0
Loop
I have tried changing the second line to a 1 but with no luck, googling and browsing forums it has suggested to 'set' the worksheets but with no luck.
Any help would be appreciated!
Happy 2010!
Andy
Bookmarks