Wht is this Code not Working ?
Hi Tom
I certainly do have values in G2 through G49. It retrives all the database
data required, pops the first formula in S2 but doesn't copy down (S2
combines the first and surname in F & G). It works perfectly when I open the
workbook as explained but not when called within a module - exact copy below
in first post
"Tom Ogilvy" wrote in message
...
It worked fine for me.
What do you mean by does not run?
Do you have values in G2:G?
--
Regards,
tom Ogilvy
"John" wrote in message
...
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(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
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: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
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
|