J
John
Could anyone explain why a particular part of this code (see below) does not
run
Range("S2.S2").Copy
x = 2
Do Until Cells(x, 7).Value = ""
Cells(x, 19).PasteSpecial xlPasteFormulas
x = x + 1
Loop
despite the fact that I have the same code which executes as a Workbook_Open
routine within the module ThisWorkbook
The code should copy the formula in S2 down until the last value in Column
7. I sometimes want to refresh the data from the database. Currently the
database data is retrived only on open.
Thanks
Sub Refresh_Timepoint()
Sheets("Database").Select
Cells.Select
Selection.ClearContents
Range("A1").Select
Sheets("Database").Select
With ActiveSheet.QueryTables.Add(Connection:=Array(Array( _
"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;SafeTransactions=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
Range("A1").Select
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").Select
Application.CutCopyMode = False
Selection.NumberFormat = "DD/MM/YY"
Columns("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").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
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
End Sub
run
Range("S2.S2").Copy
x = 2
Do Until Cells(x, 7).Value = ""
Cells(x, 19).PasteSpecial xlPasteFormulas
x = x + 1
Loop
despite the fact that I have the same code which executes as a Workbook_Open
routine within the module ThisWorkbook
The code should copy the formula in S2 down until the last value in Column
7. I sometimes want to refresh the data from the database. Currently the
database data is retrived only on open.
Thanks
Sub Refresh_Timepoint()
Sheets("Database").Select
Cells.Select
Selection.ClearContents
Range("A1").Select
Sheets("Database").Select
With ActiveSheet.QueryTables.Add(Connection:=Array(Array( _
"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;SafeTransactions=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
Range("A1").Select
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").Select
Application.CutCopyMode = False
Selection.NumberFormat = "DD/MM/YY"
Columns("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").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
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
End Sub