Problem with Query
I am only a novice at code but have recorded and then added bits to the
following code which extracts data from a MS Access database. I have placed
it with 'This Workbook' to fire on open and everything works correctly. My
problem starts is when I try to run the code again (to simply refresh the
data) when the following actions will not run i.e. it does not copy down to
cells below
x = 2
Do Until Cells(x, 7).Value = ""
Cells(x, 19).PasteSpecial xlPasteFormulas
x = x + 1
Loop
The full code (which is exactly) what fires on open - and works great is as
follows). Are there parts to this code which I don't need, maybe that is
stopping the code (refresh) from working? That said everthing within the
'refresh' code works except the part that copies down the formula from S2.
BTW there is data in G2:G.
I have posted in our groups but I'm lost and baffled as to why the code will
work in fully on opening but not when forced
Thanks
Sub Refresh_Timepoint()
Sheets("Database").Select
Cells.Select
Selection.ClearContents
Range("A1").Select
Sheets("Database").Select
With ActiveSheet.QueryTables.Add(Connection:=Array(Arra y( _
"ODBC;DBQ=C:\timepoint\Timepoint_be.MDB;DefaultDir =C:\timepoint;Driver={Micr
osoft Access Driver (*.mdb)};DriverId=281;FIL=MS Access;M" _
), Array( _
"axBufferSize=2048;MaxScanRows=8;PageTimeout=5;Saf eTransactions=0;Threads=3;
UID=admin;UserCommitSync=Yes;" _
)), Destination:=Range("A1"))
.CommandText = Array( _
"SELECT Employees.StaffNum, Employees.DeptNum, Employees.PayrollNum,
Employees.ContractType, Employees.EmployeeType, Employees.Forename,
Employees.Surname, Employees.EmpAddress1, Employees.EmpAddress2," _
, _
" Employees.EmpAddress3, Employees.EmpAddress4,
Employees.DateOfBirth, Employees.TerminationDate,
Employees.TerminationPeriod, Employees.CommencementDate,
Employees.CommencementPeriod, Employees.PayRat" _
, _
"e, Employees.NatInsNum" & Chr(13) & "" & Chr(10) & "FROM
`C:\timepoint\Timepoint_be`.Employees Employees" & Chr(13) & "" & Chr(10) &
"ORDER BY Employees.Surname" _
)
.Name = "Query from Timepoint"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = True
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=True
End With
Application.ScreenUpdating = False
With Application
.Calculation = xlManual
.MaxChange = 0.001
End With
Sheets("Database").Select
Range("A1").Select
Columns("L:M").Select
Application.CutCopyMode = False
Selection.NumberFormat = "DD/MM/YY"
Columns("N:N").Select
Application.CutCopyMode = False
Selection.NumberFormat = "####-##"
Columns("o:o").Select
Application.CutCopyMode = False
Selection.NumberFormat = "DD/MM/YY"
Columns("P:P").Select
Application.CutCopyMode = False
Selection.NumberFormat = "####-##"
Columns("Q:Q").Select
Application.CutCopyMode = False
Selection.NumberFormat = "?#,##0.00"
Columns("B:B").Select
Selection.Replace What:="1", Replacement:="Crew", LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:="99", Replacement:="Mgr", LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False
Columns("D:D").Select
Selection.Replace What:="10", Replacement:="Crew F/T", LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:="11", Replacement:="Crew P/T", LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:="12", Replacement:="Mgr F/T", LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:="13", Replacement:="Mgr P/T", LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False
ActiveWorkbook.PrecisionAsDisplayed = False
Sheets("Database").Select
Range("S2").Select
ActiveCell.Formula = "=PROPER(F2&"" ""&G2)"
Range("S2.S2").Copy
x = 2
Do Until Cells(x, 7).Value = ""
Cells(x, 19).PasteSpecial xlPasteFormulas
x = x + 1
Loop
With Application
.Calculation = xlAutomatic
.MaxChange = 0.001
End With
ActiveWorkbook.PrecisionAsDisplayed = False
Application.ScreenUpdating = True
Sheets("Database").Select
Range("A1").Select
Sheets("Home").Select
Range("A1").Select
End Sub
|