Solved: Does VBA need a pause inserted

Hello
I am trying to run the following off a button on a userform. If I progress it one step at a time it works but if I run it from the button it stops at
Workbooks("DEFG Macro plus.xls").Sheets("Sheet1").Activate
I think it might be running too fast but haven't a clue how to insert a pause between steps

[vba]Private Sub ABCDSortedView_Click()

Workbooks("Search tool2Southall.xls").Close

Workbooks("DEFG Macro plus.xls").Sheets("Sheet1").Activate

ActiveWindow.WindowState = xlMinimized

Application.Run "'DEFG Macro plus.xls'!DEFGFiltering2"

Options.Hide

End Sub[/VBA]

I did try this off the net but coudn't get it to work.I don't know if I was barking up the wrong tree or just barking.

1. [VBA]
   1. Option Compare Database
   2. Option Explicit
   3. Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
   [/VBA]Then put this where you want to wait:

Expand|Select|Wrap|Line Numbers
[vba]

1. Sleep (10000)[/vba]

This waits 10 seconds before moving to the next line

Obviously I don't want it to wait that long but it was a try.
All help gratefully acknowledged in advance.

Gil

You could also try DoEvents.

Maybe a better way though is to pass the sheet as a variable to your sub. That way, no need to activate anything. You'll need to tweak your sub to use the reference.

[vba] Set ws = Workbooks("DEFG Macro plus.xls").Sheets("Sheet1")
Application.Run "'DEFG Macro plus.xls'!DEFGFiltering2", ws
[/vba]

I see Compare Database in your code. Are you runing this from an Access form?

Hello mdmackillop
Many thanks for your speedy reply. Of course you know what I am going to say " I have tried but where does it fit in and what needs tweaking"
Sorry for this.
Gil

Can you post the code for DEFGFiltering2

Hello
Is this what you want. It works for me. Substitute the DEFG for SMPF. The target sheet to run on is called ExcelSheet.

[vba]Option Explicit
Sub SMPFFiltering2()
'
' SMPFFiltering Macro
Dim ws As Worksheet
Dim ShNames, s
Dim wsSource As Worksheet
Dim FiltRng As Range
Dim Tgts, t
Dim rng As Range
Const COLUMN_SOURCE As String = "A" '<<<< change to suit
ShNames = Array("EDITED", "NEW", "EXISTS", "LIC to D Cease", "E to BAR PAIR Cease", "DONOR")
For Each s In ShNames
Set ws = Sheets.Add
ws.Name = s
Next
Set wsSource = Sheets("Edited")
Sheets("Jumpering Schedule").Cells.Copy wsSource.Range("A1")
With wsSource
.Activate

With .Cells
.Borders.LineStyle = xlNone
Cells.Select
End With
With Selection.font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10

End With

.PageSetup.PrintArea = ""

With .PageSetup
.LeftFooter = "Edited"
.CenterFooter = "&F &A"

.RightFooter = "&P of &N"
.Orientation = xlLandscape

End With
Set rng = .Columns("A:I")
End With

Tgts = Array("NEW", "EXISTS", "DONOR", "LIC to D Cease", "E to BAR PAIR Cease")

For Each t In Tgts
rng.AutoFilter Field:=1, Criteria1:=t
On Error Resume Next
Set FiltRng = rng.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not FiltRng Is Nothing Then
FiltRng.EntireRow.Copy Worksheets(t).Range("A1")
End If
rng.AutoFilter
With Sheets(t).PageSetup
.LeftFooter = t
.CenterFooter = "&F&A" & Chr(10) & "&D"
.RightFooter = "&P of &N"
.FooterMargin = Application.InchesToPoints(0.31496062992126)
End With

Sheets(t).Columns("A:I").EntireColumn.AutoFit
Next

Sheets("EDITED").Select

Columns("B:B").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="=0*", Operator:=xlAnd
Selection.Copy
Sheets("NEW").Select
Columns("D:D").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=True, Transpose:=False
Columns("F:F").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=True, Transpose:=False

Sheets("NEW").Select

With ActiveSheet.PageSetup
.Orientation = xlLandscape
End With

Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Cells.Select
Selection.NumberFormat = "General"
Range("a1").Select
ActiveCell.FormulaR1C1 = "NEW"

Range("A2").Select
ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(SEARCH(R1C[0],C[1])),1,"""")"
Selection.AutoFill Destination:=Range("A2:A100"), Type:=xlFillDefault
Range("A2:A100").Select

Columns("A:A").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Columns("A:A").Select
Selection.SpecialCells(xlCellTypeConstants, 1).Select
Selection.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, _
Step:=1, Trend:=False

Columns("A:A").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom

Columns("A:A").Select
Selection.Copy

Columns("G:G").Select
Selection.Insert Shift:=xlToRight
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("G:G").Select
Selection.Insert Shift:=xlToRight
End With

Columns("A:K").EntireColumn.AutoFit

Sheets("EXISTS").Select
With ActiveSheet.PageSetup
.Orientation = xlLandscape
Columns("C:C").Select
Selection.Copy
Sheets("NEW").Select
Columns("D:D").Select
ActiveSheet.Paste
Columns("L:L").Select
ActiveSheet.Paste
Columns("E:E").Select
Selection.Copy

End With

Sheets("EXISTS").Select

Columns("D:D").Select
ActiveSheet.Paste
Columns("F:F").Select
ActiveSheet.Paste
Columns("F:F").Select
Selection.Insert Shift:=xlToRight

Columns("A:A").Select
Selection.Insert Shift:=xlToRight

Cells.Select
Selection.NumberFormat = "General"

Range("a1").Select
ActiveCell.FormulaR1C1 = "EXISTS"

Range("A2").Select
ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(SEARCH(R1C[0],C[1])),1,"""")"
Selection.AutoFill Destination:=Range("A2:A100"), Type:=xlFillDefault
Range("A2:A100").Select

Columns("A:A").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Columns("A:A").Select
Selection.SpecialCells(xlCellTypeConstants, 1).Select
Selection.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, _
Step:=1, Trend:=False

Columns("A:A").Select
Selection.Copy
Columns("G:G").Select
ActiveSheet.Paste
Columns("G:G").Select
Selection.Insert Shift:=xlToRight

Columns("A:L").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
End With

Columns("H:L").Select
Selection.Copy
Sheets("LIC to D Cease").Select
Columns("A:E").Select
ActiveSheet.Paste
Application.CutCopyMode = False

Columns("D:D").Select

Selection.Replace What:="conc ", Replacement:=".", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Columns("A:E").Select
Selection.Copy

Columns("G:K").Select
ActiveSheet.Paste
Application.CutCopyMode = False

Columns("A:K").Select
Selection.Columns.AutoFit

Columns("A:F").Select

Selection.Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Columns("H:L").Select

Selection.Sort Key1:=Range("K1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Range("A1:L1").Select
Selection.Insert Shift:=xlDown

Columns("A:L").EntireColumn.AutoFit

Sheets("EXISTS").Select
Columns("K:K").Select

Selection.Replace What:="conc ", Replacement:=".", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Columns("A:F").Select
Selection.Copy


Sheets("E to BAR PAIR Cease").Select
Columns("A:F").Select

ActiveSheet.Paste

Columns("H:M").Select
ActiveSheet.Paste

Columns("A:F").Select
Selection.Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Columns("H:M").Select
Selection.Sort Key1:=Range("M1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal



Range("A1:M1").Select
Selection.Insert Shift:=xlDown

Columns("A:M").EntireColumn.AutoFit

Sheets("LIC to D Cease").Select

With ActiveSheet.PageSetup
.Orientation = xlLandscape
End With

ActiveWindow.View = xlPageBreakPreview

Set ActiveSheet.HPageBreaks(1).Location = Range("A33")
ActiveWindow.SmallScroll Down:=37
Set ActiveSheet.HPageBreaks(2).Location = Range("A65")

ActiveSheet.PageSetup.PrintArea = "$A$1:$M$96"

ActiveWindow.View = xlNormalView

Sheets("E to BAR PAIR Cease").Select
ActiveWindow.View = xlPageBreakPreview

With ActiveSheet.PageSetup
.Orientation = xlLandscape
End With

Set ActiveSheet.HPageBreaks(1).Location = Range("A33")

Set ActiveSheet.HPageBreaks(2).Location = Range("A65")

ActiveSheet.PageSetup.PrintArea = "$A$1:$M$96"

ActiveWindow.View = xlNormalView

Sheets("EDITED").Select
Selection.AutoFilter

Cells.Select
Selection.RowHeight = 13.5
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = "Edited"
.CenterFooter = "&F &A"
.RightFooter = "&P of &N"
.LeftMargin = Application.InchesToPoints(0.32)
.RightMargin = Application.InchesToPoints(0.59)
.TopMargin = Application.InchesToPoints(0.18)
.BottomMargin = Application.InchesToPoints(0.73)
.HeaderMargin = Application.InchesToPoints(0.14)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
End With

Columns("A:A").ColumnWidth = 12
Columns("B:B").ColumnWidth = 10.63
Columns("C:C").ColumnWidth = 11.25
Columns("D:D").ColumnWidth = 19.25
Columns("E:E").ColumnWidth = 13.38
Columns("F:F").ColumnWidth = 20.25
Columns("G:G").ColumnWidth = 13.13
Columns("H:H").ColumnWidth = 10.63
Columns("I:I").ColumnWidth = 8


End Sub[/vba]