DoEvents ActiveWorkbook.RefreshAll Run second part of Macro Once Complete

[MDY]

Hi All,
I've searched through threads and experimented with code trying to solve this one but havn't ahd any luck at this stage.

Im trying to get the second part of my Macro to run once

[VBA]
ActiveWorkbook.RefreshAll
[/VBA]

Is complete and only once it is complete without using a timer but on event finish. I had posted a similar scenario in another post:

http://www.vbaexpress.com/forum/showthread.php?t=25315

But probably wasn't specific enough.

User Keneth Hobs suggested DoEvents and Jwise tried to help me out with this but I was still unable to get this to work.

My code is as follows:

[VBA]
Sub MPMDataRefresh()
'
'

'Select MPM Database Data Sheet
Sheets("MPM Database Data").Select

'Turn Off Auto Filter
Rows("3:3").Select
Selection.AutoFilter

'Copy Data in Sheet MPM Database data
Cells.Select
Range("BH1").Activate
Selection.Copy

'Paste Data into Sheet
Sheets("MPM Data Copy").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Refresh Data in Workbook
Sheets("MPM Database Data").Select
Range("CB4").Select
Application.CutCopyMode = False
ActiveWorkbook.RefreshAll

'Enter Section here to ensure ActiveWorkbook.RefreshAll Finishes before rest of macro runs Possibly - DoEvents


'Enter Section here to ensure ActiveWorkbook.RefreshAll Finishes before rest of macro runs Possibly - DoEvents


'Enter Section here to ensure ActiveWorkbook.RefreshAll Finishes before rest of macro runs Possibly - DoEvents


'Delete Calculate values at top of sheet so that vlookup works properly

Sheets("MPM Data Copy").Select
Range("A1").Select
Selection.ClearContents
Range("A2").Select
Selection.ClearContents

'Select MPM Database Data for rest of formula
Sheets("MPM Database Data").Select

'Insert Vlookup formula into Cells to Copy data from MPM Data Copy
Range("AC4").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC1="""","""",IF(VLOOKUP(RC1,'MPM Data Copy'!R1:R65536,29,FALSE)="""","""",VLOOKUP(RC1,'MPM Data Copy'!R1:R65536,29,FALSE)))"

Range("CB4").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC1="""","""",IF(VLOOKUP(RC1,'MPM Data Copy'!R1:R65536,80,FALSE)="""","""",VLOOKUP(RC1,'MPM Data Copy'!R1:R65536,80,FALSE)))"

Range("CC4").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC1="""","""",IF(VLOOKUP(RC1,'MPM Data Copy'!R1:R65536,81,FALSE)="""","""",VLOOKUP(RC1,'MPM Data Copy'!R1:R65536,81,FALSE)))"

Range("CE4").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC1="""","""",IF(VLOOKUP(RC1,'MPM Data Copy'!R1:R65536,83,FALSE)="""","""",VLOOKUP(RC1,'MPM Data Copy'!R1:R65536,83,FALSE)))"

Range("CF4").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC1="""","""",IF(VLOOKUP(RC1,'MPM Data Copy'!R1:R65536,84,FALSE)="""","""",VLOOKUP(RC1,'MPM Data Copy'!R1:R65536,84,FALSE)))"

Range("CH4").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC1="""","""",IF(VLOOKUP(RC1,'MPM Data Copy'!R1:R65536,86,FALSE)="""","""",VLOOKUP(RC1,'MPM Data Copy'!R1:R65536,86,FALSE)))"

Range("CK4").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC1="""","""",IF(VLOOKUP(RC1,'MPM Data Copy'!R1:R65536,89,FALSE)="""","""",VLOOKUP(RC1,'MPM Data Copy'!R1:R65536,89,FALSE)))"

Range("CL4").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC1="""","""",IF(VLOOKUP(RC1,'MPM Data Copy'!R1:R65536,90,FALSE)="""","""",VLOOKUP(RC1,'MPM Data Copy'!R1:R65536,90,FALSE)))"

'Fill down the Formulas as Above to the Spreadsheet
Range("AC4:AC5000").Select
Selection.FillDown

Range("CB4:CC5000").Select
Selection.FillDown

Range("CE4:CF5000").Select
Selection.FillDown

Range("CH4:CH5000").Select
Selection.FillDown

Range("CK4:CL5000").Select
Selection.FillDown

'Copy and Paste the Cells Section of Macro
Range("AC4:AC5000").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("CB4:CC5000").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("CE4:CF5000").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.SmallScroll ToRight:=3

Range("CH4:CH5000").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("CK4:CL5000").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Sort Records by Project Ranking
'Selct Rows to Sort
Rows("3:5000").Select
Range("CD3").Activate
Application.CutCopyMode = False
Selection.Sort Key1:=Range("H4"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortTextAsNumbers
ActiveWindow.SmallScroll ToRight:=6

'Filter Records by Current Records
Rows("3:3").Select
Range("CE3").Activate
Selection.AutoFilter
ActiveWindow.SmallScroll ToRight:=21
Range("CM4").Select
Selection.AutoFilter Field:=91, Criteria1:="Current"
ActiveWindow.SmallScroll ToRight:=-18
End Sub
[/VBA]

It would be awesome if someone could give me a hand on this one.

Thanks

MDY

[ZVI]

Hi MDY,

Triggering of Query AfterRefresh event can be used - see the attached example.

In Sheet1 is the query to the login table of http://www.vbaexpress.com/
Try the refreshing to see the order of actions.

The code of ThisWorkbook module:

' ZVI:2010-02-24 http://www.vbaexpress.com/forum/showthread.php?t=30743
' Run MacroPart2 after query refreshing
' === The code of ThisWorkbook (class) module ===

Public WithEvents QT As QueryTable

' Associate QT with QueryTable of Sheet1
Private Sub Workbook_Open()
  On Error Resume Next
  Set QT = Sheet1.QueryTables(1)
End Sub

' After Refresh event trigger
Private Sub QT_AfterRefresh(ByVal Success As Boolean)
  If Success = True Then
    MsgBox "Query completed successfully"
    MacroPart2  ' <-- Run MacroPart2 after query refreshing
  Else
    MsgBox "Query failed or was cancelled"
  End If
End Sub


' === The code below could be into standard VBA-module as well ===

' First stuff with RefreshAll at the end of macro
Sub MacroPart1()
  Sheet1.Range("A3:H4").ClearContents ' <-- here is the query range
  MsgBox "MacroPart1 is running"      ' <-- It's just for testing
  Thisworkbook.RefreshAll
End Sub

' This macro will be called from QT_AfterRefresh code
Sub MacroPart2()
  MsgBox "MacroPart2 is running"
End Sub

Regards,
Vladimir

[MDY]

Hi ZVI,
I'm really sorry but my VB knowledge is limited and I'm really struggling to understand what to do here.

What do I need to add to my Macro to ensure that the refresh finishes before the second part of the macro runs?

Thanks for your help.

MDY

[ZVI]

Ok, try such tweaking of the code of your workbook:

1. Copy all code shown in post#2 into ThisWorkbook module of your workbook.
2. Copy into MacroPart1 the top part of your MPMDataRefresh code up to the line with ActiveWorkbook.RefreshAll .
3. Copy into MacroPart2 the rest lines of MPMDataRefresh code which are below the line with ActiveWorkbook.RefreshAll

As the result your code of MPMDataRefresh macro now are in two parts, i.e. in MacroPart1 and MacroPart2 macros, and MPMDataRefresh subroutine is not required.

Below is template for MacroPart1 and MacroPart2:

' First stuff with RefreshAll at the end of macro
Sub MacroPart1()
  ' Part of the code copied from your MPMDataRefresh
  ' from top up to the line with ActiveWorkbook.RefreshAll
End Sub

' This macro will be called from QT_AfterRefresh code
Sub MacroPart2()
  ' The rest lines of MPMDataRefresh code
  ' which are below the line with ActiveWorkbook.RefreshAll
End Sub

It’s assumed that only one query is in your workbook.
For adjusting replace this line of Workbook_Open code: Set QT = Sheet1.QueryTables(1)
by that one: Set QT = Sheets("YourSheetNameWithQuery").QueryTables(1)
Instead of ""YourSheetNameWithQuery"" apply the appropriate sheet name where the query is.

If more than one queries are used or if you stuck then could you provide workbook example with dummy data?

Vladimir

[SamT]

Try this:
[vba]
Sub MPMDataRefresh()
'
'
Dim DummyVar 'Used with DoEvents

'Select MPM Database Data Sheet
With Sheets("MPM Database Data")
Rows("3:3").AutoFilter VisibleDropDown:=False 'Turn them OFF
Range("BH1").Copy
Rows("3:3").AutoFilter VisibleDropDown:=True 'Turn them ON
End With

'Paste Data into Sheet
Sheets("MPM Data Copy").Range("A1").PasteSpecial _
Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks :=False, _
Transpose:=False

Application.CutCopyMode = False
'Refresh Data in Workbook
ThisWorkbook.RefreshAll

DummyVar = DoEvents()
'Delete Calculate values at top of sheet so that vlookup works properly

Sheets("MPM Data Copy").Range("A1:A2").ClearContents

'Select MPM Database Data for rest of formula
Sheets("MPM Database Data").Activate

'Insert Vlookup formula into Cells to Copy data from MPM Data Copy
Range("AC4").FormulaR1C1 = "=IF(RC1="""", _
"""", _
IF(VLOOKUP(RC1,'MPM Data Copy'!R1:R65536,29,FALSE)="""", _
"""", _
VLOOKUP(RC1,'MPM Data Copy'!R1:R65536,29,FALSE)))"

Range("CB4").FormulaR1C1 = "=IF(RC1="""", _
"""", _
IF(VLOOKUP(RC1,'MPM Data Copy'!R1:R65536,80,FALSE)="""", _
"""", _
VLOOKUP(RC1,'MPM Data Copy'!R1:R65536,80,FALSE)))"

Range("CC4").FormulaR1C1 = "=IF(RC1="""", _
"""", _
IF(VLOOKUP(RC1,'MPM Data Copy'!R1:R65536,81,FALSE)="""", _
"""", _
VLOOKUP(RC1,'MPM Data Copy'!R1:R65536,81,FALSE)))"

Range("CE4").FormulaR1C1 = "=IF(RC1="""", _
"""", _
IF(VLOOKUP(RC1,'MPM Data Copy'!R1:R65536,83,FALSE)="""", _
"""", _
VLOOKUP(RC1,'MPM Data Copy'!R1:R65536,83,FALSE)))"

Range("CF4").FormulaR1C1 = "=IF(RC1="""", _
"""", _
IF(VLOOKUP(RC1,'MPM Data Copy'!R1:R65536,84,FALSE)="""", _
"""", _
VLOOKUP(RC1,'MPM Data Copy'!R1:R65536,84,FALSE)))"

Range("CH4").FormulaR1C1 = "=IF(RC1="""", _
"""", _
IF(VLOOKUP(RC1,'MPM Data Copy'!R1:R65536,86,FALSE)="""", _
"""", _
VLOOKUP(RC1,'MPM Data Copy'!R1:R65536,86,FALSE)))"

Range("CK4").FormulaR1C1 = "=IF(RC1="""", _
"""", _
IF(VLOOKUP(RC1,'MPM Data Copy'!R1:R65536,89,FALSE)="""", _
"""", _
VLOOKUP(RC1,'MPM Data Copy'!R1:R65536,89,FALSE)))"

Range("CL4").FormulaR1C1 = "=IF(RC1="""", _
"""", _
IF(VLOOKUP(RC1,'MPM Data Copy'!R1:R65536,90,FALSE)="""", _
"""", _
VLOOKUP(RC1,'MPM Data Copy'!R1:R65536,90,FALSE)))"

'Fill down the Formulas as Above to the Spreadsheet
Range("AC4:AC5000").FillDown
Range("CB4:CC5000").FillDown
Range("CE4:CF5000").FillDown
Range("CH4:CH5000").FillDown
Range("CK4:CL5000").FillDown

DummyVar = DoEvents()
'Copy and Paste the Cells Section of Macro
Range("AC4:AC5000").Copy
Range("AC4:AC5000").PasteSpecial
Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks :=False, _
Transpose:=False

Range("CB4:CC5000").Copy
Range("CB4:CC5000").PasteSpecial
Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks :=False, _
Transpose:=False

Range("CE4:CF5000").Copy
Range("CE4:CF5000").PasteSpecial
Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks :=False, _
Transpose:=False

Range("CE4:CF5000").Copy
Range("CE4:CF5000").PasteSpecial
Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks :=False, _
Transpose:=False

'Paste Values from CE4:CF5000
Range("CK4:CL5000").PasteSpecial
Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks :=False, _
Transpose:=False

Application.CutCopyMode = False
' ActiveWindow.SmallScroll ToRight:=3
'Sort Records by Project Ranking
'Select Rows to Sort
Rows("3:5000").Select
Range("CD3").Activate
Selection.Sort Key1:=Range("H4"), _
Order1:=xlDescending, _
Header:=xlGuess, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortTextAsNumbers

' ActiveWindow.SmallScroll ToRight:=6

'Filter Records by Current Records
Rows("3:3").AutoFilter VisibleDropDown:=False 'Turn Them OFF
' ActiveWindow.SmallScroll ToRight:=21
Range("CM4").Select
Selection.AutoFilter Field:=91, Criteria1:="Current"
ActiveWindow.SmallScroll ToRight:=-18
'Turn Dropdowns ON?
End Sub
[/vba]