VBA to Execute refresh query results, allow the formulas to calculate based on query results then copy/past values to another sheet

[mamyers64]

I need my macro to copy SQL code from a cell which contains a formula that concatenates all the lines of code above it. I have a sheet that captures user entered parameters which is used to build the SQL code and then a button that the user clicks to run the query. I have another sheet with formulas that depend on the query results, of which I have another macro that copies the values and formats over to another sheet, all within the same workbook. I prefer to have only one button which executes the chain of macros. The problem is that even with an "Application.Wait Now + #12:00:10 AM#" command the values that get copied over to the Final Report sheet do not reflect the query results. It only takes the query 3 seconds to complete but I can see that during the waiting period the formulas do not update, only after the macros are done do the formulas calculate.

Below is the code that copies the SQL to the query (Run_WCSum) and below that is the code (Make_Final) that copies the values and formats over to the Final Report sheet. Below these two macros is all the other code in another module and declarations necessary for Run_WCSum to run. These declarations and macro were written many years ago in an earlier version of Excel/Windows; it was necessary to overcome a limitation on the amount of text that could be copied from a cell and pasted into the query window. If there is a more efficient way to do this with the newer versions of Windows/Excel then I am open to suggestions; though this is a secondary question because it still works fine.

' Module 1:[/B]

Public Sub [B]Run_WCSum[/B]()

' make visible the SQL sheet normally hidden from users
Sheet5.Visible = xlSheetVisible
   
' Goto formula containing concatenation formula of SQL code
Application.GoTo Reference:="sqlOne"
Selection.Copy
   
' Copy Content
Dim sqlOne As String
sqlOne = ClipBoard_GetText()
       
' Goto OLE DB Query
Application.GoTo Reference:="rptWCSum"
   
' Get QueryTable Object
Dim sqlOne_QUERYTABLE As QueryTable
Set sqlOne_QUERYTABLE = Application.ActiveCell.QueryTable
       
' Modify Command Text Query
sqlOne_QUERYTABLE.CommandText = sqlOne
sqlOne_QUERYTABLE.Refresh True
   
DoEvents
   
If Err <> 0 Then MsgBox Err.Description


Application.CutCopyMode = False
   
   
' Hide the SQL sheety
Sheet5.Visible = xlVeryHidden
   
Application.GoTo Reference:="selTop"

Call Make_Final
   
End Sub



Public Sub [B]Make_Final[/B]()




Application.GoTo Reference:="selTop"

Application.Wait Now + #12:00:10 AM#
   
   
Cells.Select
Selection.Copy
Sheets("Final Report").Select
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("A1").Select

' This code deletes the columns with a heading of Saturday or Sunday
Dim c As Range


With Rows(2)
Do
Set c = .Find("Saturday", LookIn:=xlValues, LookAt:=xlPart)
If c Is Nothing Then Exit Do
c.EntireColumn.Delete
Loop
End With
   
With Rows(2)
Do
Set c = .Find("Sunday", LookIn:=xlValues, LookAt:=xlPart)
If c Is Nothing Then Exit Do
c.EntireColumn.Delete
Loop
End With


End Sub


[B]' Module 2: 

' (Declarations)[/B]


Public Const GHND = &H42
Public Const CF_TEXT = 1
Private Const CF_ANSIONLY = &H400&
Private Const CF_APPLY = &H200&
Private Const CF_BITMAP = 2
Private Const CF_DIB = 8
Private Const CF_DIF = 5
Private Const CF_DSPBITMAP = &H82
Private Const CF_DSPENHMETAFILE = &H8E
Private Const CF_DSPMETAFILEPICT = &H83
Private Const CF_DSPTEXT = &H81
Private Const CF_EFFECTS = &H100&
Private Const CF_ENABLEHOOK = &H8&
Private Const CF_ENABLETEMPLATE = &H10&
Private Const CF_ENABLETEMPLATEHANDLE = &H20&
Private Const CF_ENHMETAFILE = 14
Private Const CF_FIXEDPITCHONLY = &H4000&
Private Const CF_FORCEFONTEXIST = &H10000
Private Const CF_GDIOBJFIRST = &H300
Private Const CF_GDIOBJLAST = &H3FF
Private Const CF_HDROP = 15
Private Const CF_INITTOLOGFONTSTRUCT = &H40&
Private Const CF_LIMITSIZE = &H2000&
Private Const CF_LOCALE = 16
Private Const CF_MAX = 17
Private Const CF_METAFILEPICT = 3
Private Const CF_NOFACESEL = &H80000
Private Const CF_NOSCRIPTSEL = &H800000
Private Const CF_NOSIMULATIONS = &H1000&
Private Const CF_NOSIZESEL = &H200000
Private Const CF_NOSTYLESEL = &H100000
Private Const CF_NOVECTORFONTS = &H800&
Private Const CF_NOOEMFONTS = CF_NOVECTORFONTS
Private Const CF_NOVERTFONTS = &H1000000
Private Const CF_OEMTEXT = 7
Private Const CF_OWNERDISPLAY = &H80
Private Const CF_PALETTE = 9
Private Const CF_PENDATA = 10
Private Const CF_PRINTERFONTS = &H2
Private Const CF_PRIVATEFIRST = &H200
Private Const CF_PRIVATELAST = &H2FF
Private Const CF_RIFF = 11
Private Const CF_SCALABLEONLY = &H20000
Private Const CF_SCREENFONTS = &H1
Private Const CF_BOTH = (CF_SCREENFONTS Or CF_PRINTERFONTS)
Private Const CF_SCRIPTSONLY = CF_ANSIONLY
Private Const CF_SELECTSCRIPT = &H400000
Private Const CF_SHOWHELP = &H4&
Private Const CF_SYLK = 4
Private Const CF_TIFF = 6
Private Const CF_TTONLY = &H40000
Private Const CF_UNICODETEXT = 13
Private Const CF_USESTYLE = &H80&
Private Const CF_WAVE = 12
Private Const CF_WYSIWYG = &H8000


Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags&, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long


Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long


Private Declare Function OpenClipboard Lib "user32" (ByVal Hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long


Public Function [B]ClipBoard_SetText[/B](strCopyString As String) As Boolean
Dim hGlobalMemory As Long
Dim lpGlobalMemory As Long
Dim hClipMemory As Long
      
hGlobalMemory = GlobalAlloc(GHND, Len(strCopyString) + 1)
   
lpGlobalMemory = GlobalLock(hGlobalMemory)
   
lpGlobalMemory = lstrcpy(lpGlobalMemory, strCopyString)
   
If GlobalUnlock(hGlobalMemory) = 0 Then
If OpenClipboard(0&) <> 0 Then
Call EmptyClipboard
hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
ClipBoard_SetText = CBool(CloseClipboard)
End If
End If
End Function


Public Function [B]ClipBoard_GetText[/B]() As String
Dim hClipMemory As Long
Dim lpClipMemory As Long
Dim strCBText As String
Dim RetVal As Long
Dim lngSize As Long
If OpenClipboard(0&) <> 0 Then
hClipMemory = GetClipboardData(CF_TEXT)
If hClipMemory <> 0 Then
           
lpClipMemory = GlobalLock(hClipMemory)
If lpClipMemory <> 0 Then
lngSize = GlobalSize(lpClipMemory)
strCBText = Space$(lngSize)
RetVal = lstrcpy(strCBText, lpClipMemory)
RetVal = GlobalUnlock(hClipMemory)
strCBText = Left(strCBText, InStr(1, strCBText, Chr$(0), 0) - 1)
Else
MsgBox "Could not lock memory to copy string from."
End If
End If
Call CloseClipboard
End If
   
ClipBoard_GetText = strCBText
End Function




Public Function [B]CopyOlePiccy[/B](Piccy As Object)
Dim hGlobalMemory As Long, lpGlobalMemory As Long
Dim hClipMemory As Long, X As Long
   
hGlobalMemory = GlobalAlloc(GHND, Len(Piccy) + 1)
lpGlobalMemory = GlobalLock(hGlobalMemory)
lpGlobalMemory = lstrcpy(lpGlobalMemory, Piccy)
   
' Unlock the memory.
If GlobalUnlock(hGlobalMemory) <> 0 Then
MsgBox "Could not unlock memory location. Copy aborted."
GoTo OutOfHere2
End If
   
If OpenClipboard(0&) = 0 Then
MsgBox "Could not open the Clipboard. Copy aborted."
Exit Function
End If
   
X = EmptyClipboard()
hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
   
OutOfHere2:
If CloseClipboard() = 0 Then
MsgBox "Could not close Clipboard."
End If
End Function

 

[mamyers64]

I believe I found the solution.

NOTE: WCSum is the actual query results and rptWCSum is a named location in the top/left cell of the query results. Referencing the query results by it's name in the macro doesn't work for me so I do it indirectly.

First I had to convert the query results (WCSum) to a table

The VBA to fresh a query table is different so I replaced Run_WCSum with this:

Public Sub Run_WCSum()

' make visible the SQL sheet normally hidden from users
Sheet5.Visible = xlSheetVisible

' Goto formula containing concatenation formula of SQL code
 Application.Goto Reference:="sqlOne"
 Selection.Copy

 ' Copy Content
 Dim sqlOne As String
 sqlOne = ClipBoard_GetText()

Application.Goto Reference:="rptWCSum"

 With Selection.ListObject.QueryTable
 .CommandType = xlCmdSql
 .CommandText = sqlOne
 .Refresh BackgroundQuery:=False
 End With
 DoEvents

If Err <> 0 Then MsgBox Err.Description

Application.CutCopyMode = False

' Hide the SQL sheet
Sheet5.Visible = xlVeryHidden

Application.Goto Reference:="selTop"

Call Make_Final

End Sub

Next, I removed the wait code from Make_Final so it now looks like this:

Public Sub Make_Final()

Application.Goto Reference:="selTop"

Cells.Select
Selection.Copy
Sheets("Final Report").Select
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("A1").Select

' This code deletes the columns with a heading of Saturday or Sunday
Dim c As Range

With Rows(2)
Do
Set c = .Find("Saturday", LookIn:=xlValues, LookAt:=xlPart)
If c Is Nothing Then Exit Do
c.EntireColumn.Delete
Loop
End With

With Rows(2)
Do
Set c = .Find("Sunday", LookIn:=xlValues, LookAt:=xlPart)
If c Is Nothing Then Exit Do
c.EntireColumn.Delete
Loop
End With

End Sub

From Module 2 I deleted ClipBoard_SetText and CopyOlePic because they are no longer being called out. I kept all the declarations and ClipBoard_GetText.