ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Links and Linking in Excel (https://www.excelbanter.com/links-linking-excel/)
-   -   Problem with Query (https://www.excelbanter.com/links-linking-excel/519-problem-query.html)

John

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



Bill Manville

John wrote:
Range("S2.S2").Copy


That statement should cause an error.
Range("S2").Copy
would be fine.

You have asked it to carry out the query in the background which means
that the query may not have completed by the time you try to copy and
paste the formula.

The code could be tightened up quite a bit as there is quite a lot of
unnecessary selecting being done, but that's the way the macro recorder
works.

For the record, I would reduce it to something like this:

Sub Refresh_Timepoint()
Sheets("Database").Select
ActiveSheet.UsedRange.ClearContents
With ActiveSheet.QueryTables.Add( _
Connection:="ODBC;DBQ=C:\timepoint\Timepoint_be.MD B", _
Destination:=Range("A1"))
.CommandText = "SELECT StaffNum, DeptNum, PayrollNum, " & _
"ContractType, EmployeeType, Forename, Surname, EmpAddress1, " & _
"EmpAddress2, EmpAddress3, EmpAddress4, DateOfBirth, " & _
"TerminationDate, TerminationPeriod, CommencementDate, " & _
"CommencementPeriod, PayRate, NatInsNum " & _
"FROM Employees ORDER BY Surname"
.Name = "Query from Timepoint"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = True
.BackgroundQuery = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=False
End With

Application.ScreenUpdating = False

Application.Calculation = xlManual

Columns("L:M").NumberFormat = "DD/MM/YY"

Columns("N:N").NumberFormat = "####-##"

Columns("o:o").NumberFormat = "DD/MM/YY"

Columns("P:P").NumberFormat = "####-##"

Columns("Q:Q").NumberFormat = "?#,##0.00"

With Columns("B:B")
.Replace What:="1", Replacement:="Crew", LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False
.Replace What:="99", Replacement:="Mgr", LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False
End With

With Columns("D:D")
.Replace What:="10", Replacement:="Crew F/T", LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False
.Replace What:="11", Replacement:="Crew P/T", LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False
.Replace What:="12", Replacement:="Mgr F/T", LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False
.Replace What:="13", Replacement:="Mgr P/T", LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False
End With

Range("S2", Cells(Range("G2").End(xlDown).Row, "S")).Formula = _
"=PROPER(F2&"" ""&G2)"

Application.Calculation = xlAutomatic

Sheets("Home").Select
Range("A1").Select

Application.ScreenUpdating = True

End Sub


Bill Manville
MVP - Microsoft Excel, Oxford, England
No email replies please - respond to newsgroup


John

Thanks Bill

I have given up, broken it down in to an 'add query' and then a Refresh one.
I had been running the 'add' over and over again, but all I required
apparently was refresh. Thanks for the tightened code


"Bill Manville" wrote in message
...
John wrote:
Range("S2.S2").Copy


That statement should cause an error.
Range("S2").Copy
would be fine.

You have asked it to carry out the query in the background which means
that the query may not have completed by the time you try to copy and
paste the formula.

The code could be tightened up quite a bit as there is quite a lot of
unnecessary selecting being done, but that's the way the macro recorder
works.

For the record, I would reduce it to something like this:

Sub Refresh_Timepoint()
Sheets("Database").Select
ActiveSheet.UsedRange.ClearContents
With ActiveSheet.QueryTables.Add( _
Connection:="ODBC;DBQ=C:\timepoint\Timepoint_be.MD B", _
Destination:=Range("A1"))
.CommandText = "SELECT StaffNum, DeptNum, PayrollNum, " & _
"ContractType, EmployeeType, Forename, Surname, EmpAddress1, " & _
"EmpAddress2, EmpAddress3, EmpAddress4, DateOfBirth, " & _
"TerminationDate, TerminationPeriod, CommencementDate, " & _
"CommencementPeriod, PayRate, NatInsNum " & _
"FROM Employees ORDER BY Surname"
.Name = "Query from Timepoint"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = True
.BackgroundQuery = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=False
End With

Application.ScreenUpdating = False

Application.Calculation = xlManual

Columns("L:M").NumberFormat = "DD/MM/YY"

Columns("N:N").NumberFormat = "####-##"

Columns("o:o").NumberFormat = "DD/MM/YY"

Columns("P:P").NumberFormat = "####-##"

Columns("Q:Q").NumberFormat = "?#,##0.00"

With Columns("B:B")
.Replace What:="1", Replacement:="Crew", LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False
.Replace What:="99", Replacement:="Mgr", LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False
End With

With Columns("D:D")
.Replace What:="10", Replacement:="Crew F/T", LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False
.Replace What:="11", Replacement:="Crew P/T", LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False
.Replace What:="12", Replacement:="Mgr F/T", LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False
.Replace What:="13", Replacement:="Mgr P/T", LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False
End With

Range("S2", Cells(Range("G2").End(xlDown).Row, "S")).Formula = _
"=PROPER(F2&"" ""&G2)"

Application.Calculation = xlAutomatic

Sheets("Home").Select
Range("A1").Select

Application.ScreenUpdating = True

End Sub


Bill Manville
MVP - Microsoft Excel, Oxford, England
No email replies please - respond to newsgroup




John

Bill

Just trying to run your code, and a message comes back saying its looking
for the Data Source. One thing that is different with your code is the
following, which it doesn't have, does the code need it?

DefaultDir=C:\timepoint;Driver={Microsoft 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;" _
)),


"Bill Manville" wrote in message
...
John wrote:
Range("S2.S2").Copy


That statement should cause an error.
Range("S2").Copy
would be fine.

You have asked it to carry out the query in the background which means
that the query may not have completed by the time you try to copy and
paste the formula.

The code could be tightened up quite a bit as there is quite a lot of
unnecessary selecting being done, but that's the way the macro recorder
works.

For the record, I would reduce it to something like this:

Sub Refresh_Timepoint()
Sheets("Database").Select
ActiveSheet.UsedRange.ClearContents
With ActiveSheet.QueryTables.Add( _
Connection:="ODBC;DBQ=C:\timepoint\Timepoint_be.MD B", _
Destination:=Range("A1"))
.CommandText = "SELECT StaffNum, DeptNum, PayrollNum, " & _
"ContractType, EmployeeType, Forename, Surname, EmpAddress1, " & _
"EmpAddress2, EmpAddress3, EmpAddress4, DateOfBirth, " & _
"TerminationDate, TerminationPeriod, CommencementDate, " & _
"CommencementPeriod, PayRate, NatInsNum " & _
"FROM Employees ORDER BY Surname"
.Name = "Query from Timepoint"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = True
.BackgroundQuery = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=False
End With

Application.ScreenUpdating = False

Application.Calculation = xlManual

Columns("L:M").NumberFormat = "DD/MM/YY"

Columns("N:N").NumberFormat = "####-##"

Columns("o:o").NumberFormat = "DD/MM/YY"

Columns("P:P").NumberFormat = "####-##"

Columns("Q:Q").NumberFormat = "?#,##0.00"

With Columns("B:B")
.Replace What:="1", Replacement:="Crew", LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False
.Replace What:="99", Replacement:="Mgr", LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False
End With

With Columns("D:D")
.Replace What:="10", Replacement:="Crew F/T", LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False
.Replace What:="11", Replacement:="Crew P/T", LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False
.Replace What:="12", Replacement:="Mgr F/T", LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False
.Replace What:="13", Replacement:="Mgr P/T", LookAt:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False
End With

Range("S2", Cells(Range("G2").End(xlDown).Row, "S")).Formula = _
"=PROPER(F2&"" ""&G2)"

Application.Calculation = xlAutomatic

Sheets("Home").Select
Range("A1").Select

Application.ScreenUpdating = True

End Sub


Bill Manville
MVP - Microsoft Excel, Oxford, England
No email replies please - respond to newsgroup




Bill Manville

John wrote:
One thing that is different with your code is the
following, which it doesn't have, does the code need it?


Most of the connection string can be omitted as they are default values
anyway. Looks like I was a bit too mean with what I left in!

Try adding
;Driver={Microsoft Access Driver (*.mdb)};UID=Admin
back into the connection string

Bill Manville
MVP - Microsoft Excel, Oxford, England
No email replies please - respond to newsgroup



All times are GMT +1. The time now is 07:25 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com