C
Carmen
Hi,
I'm very lost. I've written a VB that used to work (but something must have
happened and it's not working as planned).
I have two excel files (one allows user to pick criteria, the second one
takes the imported table and creates a querytable out of it for user to
refresh. Data in 2nd file is also limited to what was requested in 1st file.
In file 1, user basically chooses the criteria from header fields from a
pivot table. A macro then sets up the filter to be used in SQL. Now, some
of the fields are not working. They may work when multiple criterias are
set. I'm guessing it's probably a size problem, but my file has a max of
10,000 records only.
Is there a problem with this code?
Public Sub RefreshTableData()
'Code goes to the Criteria tab to get filter information and uses this to
grab data from dba
On Error GoTo ERRORHANDLING
Dim strFilterCriteria As String
Dim counter As Integer
Dim intTotalFilters As Integer
Dim strFilterCriteria1 As String
'criteria is from row 2 to 24 => this should not change
'code below creates the filter info
Sheets(strCriteriaTabName).Activate
intTotalFilters = 0
For counter = 2 To 24
'don't filter if a field selection is all or if no fill is
identified in column A
If (Range("B" & counter).Value = "(All)" Or Range("a" &
counter).Value = "") Then
'do nothing
Else
intTotalFilters = intTotalFilters + 1
If intTotalFilters = 1 Then
strFilterCriteria = "WHERE "
Else
strFilterCriteria = strFilterCriteria & " AND "
End If
strFilterCriteria = strFilterCriteria & "(`" & QueryName &
"`." & Range("A" & counter).Value & "='" & Range("B" & counter).Value & "')"
End If
Next counter
'deletes old info from Salary Calculations tab and populates with
most recent data from query
Sheets(SalaryDetailsTab).Activate
Range("A65:L30000").Select
Selection.ClearContents
Selection.QueryTable.Delete
With ActiveSheet.QueryTables.Add(Connection:=Array(Array( _
"ODBC;DSN=MS Access Database;DBQ=I:\CONSOLIDATION UNIT\ACCESS
DATABASE\Members Salary Forecast.mdb;DefaultDir=I:\CONSOLIDATION UNIT\" _
), Array("ACCESS DATABASE;DriverId=25;FIL=MS
Access;MaxBufferSize=2048;PageTimeout=5;")) _
, Destination:=Range("A65"))
.CommandText = Array( _
"SELECT `" & QueryName & "`.Name, `" & QueryName & "`.REG, `" &
QueryName & "`.Rank_, `" & QueryName & "`.Collator, `" & QueryName & "" _
, "`.Collator_Desc, `" & QueryName & "`.Emp_Date, `" & QueryName
& "`.Step_, `" & QueryName & "`.Step_Date, `" & QueryName & "`.Salary, `"
& QueryName & "" _
, "`.Utilization, `" & QueryName & "`.`1198 BB_`, `" & QueryName
& "`.`KU/PCA`" & Chr(13) & "" & Chr(10) & "FROM `I:\CONSOLIDATION
UNIT\ACCESS DATABASE\Members Salary Forecast`.`" & QueryName & "` " _
, "`" & QueryName & "`" & Chr(13) & "" & Chr(10) &
strFilterCriteria & Chr(13) & "" & Chr(10))
.Name = "Query from MS Access Database_3"
.FieldNames = False
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=False
End With
Exit Sub
ERRORHANDLING:
If Err.Number = 1004 Then
Resume Next
Else: MsgBox "An error of type " & Err.Number & " has occured." &
vbLf & "Error: & " & Err.Description
End If
Exit Sub
End Sub
Thanks,
Carmen
I'm very lost. I've written a VB that used to work (but something must have
happened and it's not working as planned).
I have two excel files (one allows user to pick criteria, the second one
takes the imported table and creates a querytable out of it for user to
refresh. Data in 2nd file is also limited to what was requested in 1st file.
In file 1, user basically chooses the criteria from header fields from a
pivot table. A macro then sets up the filter to be used in SQL. Now, some
of the fields are not working. They may work when multiple criterias are
set. I'm guessing it's probably a size problem, but my file has a max of
10,000 records only.
Is there a problem with this code?
Public Sub RefreshTableData()
'Code goes to the Criteria tab to get filter information and uses this to
grab data from dba
On Error GoTo ERRORHANDLING
Dim strFilterCriteria As String
Dim counter As Integer
Dim intTotalFilters As Integer
Dim strFilterCriteria1 As String
'criteria is from row 2 to 24 => this should not change
'code below creates the filter info
Sheets(strCriteriaTabName).Activate
intTotalFilters = 0
For counter = 2 To 24
'don't filter if a field selection is all or if no fill is
identified in column A
If (Range("B" & counter).Value = "(All)" Or Range("a" &
counter).Value = "") Then
'do nothing
Else
intTotalFilters = intTotalFilters + 1
If intTotalFilters = 1 Then
strFilterCriteria = "WHERE "
Else
strFilterCriteria = strFilterCriteria & " AND "
End If
strFilterCriteria = strFilterCriteria & "(`" & QueryName &
"`." & Range("A" & counter).Value & "='" & Range("B" & counter).Value & "')"
End If
Next counter
'deletes old info from Salary Calculations tab and populates with
most recent data from query
Sheets(SalaryDetailsTab).Activate
Range("A65:L30000").Select
Selection.ClearContents
Selection.QueryTable.Delete
With ActiveSheet.QueryTables.Add(Connection:=Array(Array( _
"ODBC;DSN=MS Access Database;DBQ=I:\CONSOLIDATION UNIT\ACCESS
DATABASE\Members Salary Forecast.mdb;DefaultDir=I:\CONSOLIDATION UNIT\" _
), Array("ACCESS DATABASE;DriverId=25;FIL=MS
Access;MaxBufferSize=2048;PageTimeout=5;")) _
, Destination:=Range("A65"))
.CommandText = Array( _
"SELECT `" & QueryName & "`.Name, `" & QueryName & "`.REG, `" &
QueryName & "`.Rank_, `" & QueryName & "`.Collator, `" & QueryName & "" _
, "`.Collator_Desc, `" & QueryName & "`.Emp_Date, `" & QueryName
& "`.Step_, `" & QueryName & "`.Step_Date, `" & QueryName & "`.Salary, `"
& QueryName & "" _
, "`.Utilization, `" & QueryName & "`.`1198 BB_`, `" & QueryName
& "`.`KU/PCA`" & Chr(13) & "" & Chr(10) & "FROM `I:\CONSOLIDATION
UNIT\ACCESS DATABASE\Members Salary Forecast`.`" & QueryName & "` " _
, "`" & QueryName & "`" & Chr(13) & "" & Chr(10) &
strFilterCriteria & Chr(13) & "" & Chr(10))
.Name = "Query from MS Access Database_3"
.FieldNames = False
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=False
End With
Exit Sub
ERRORHANDLING:
If Err.Number = 1004 Then
Resume Next
Else: MsgBox "An error of type " & Err.Number & " has occured." &
vbLf & "Error: & " & Err.Description
End If
Exit Sub
End Sub
Thanks,
Carmen