Solved: Does VBA need a pause inserted

[Gil]

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

[mdmackillop]

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]

[austenr]

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

[Gil]

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

[mdmackillop]

Can you post the code for DEFGFiltering2

[Gil]

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").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").Select
ActiveSheet.Paste
Columns("L:L").Select
ActiveSheet.Paste
Columns("E:E").Select
Selection.Copy

End With

Sheets("EXISTS").Select

Columns("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").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").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]