Can I repeat macro attached to data validation button 1000 times and then stop?

[ned lud]

I have a macro attached to a data validation button.

The macro first generate some random results (based on previous inputs) and then copies those random results into a different worksheet on the next open line. Thanks to others who were kind enough to help me get to this point.

My code is below.

My problem is I need 1,000 examples so I need the macro attached to the button to run 1000 times and then stop.

Is there a way to do this or do I have to click the button 1000 times?

Here is the code I have already.

Thank you for any help you may be able to provide.

----------------------


Sub macro1()
'
' macro1 Macro
'
' Keyboard Shortcut: Ctrl+a
'
ActiveWindow.SmallScroll Down:=18
Range("A21:E73").Select
ActiveWorkbook.Worksheets("Front Page").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Front Page").Sort.SortFields.Add2 Key:=Range( _
"E22:E73"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Front Page").Sort
.SetRange Range("A21:E73")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWindow.SmallScroll Down:=-18
Range("E2").Select

Range("A17:af17").Copy
Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues


End Sub

 

[Jeffrey Mahoney]

I can't test so pleas try this:

Sub macro1()
' Keyboard Shortcut: Ctrl+a
  Dim X As Long
  
  For X = 1 To 1000
    ActiveWorkbook.Worksheets("Front Page").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Front Page").Sort.SortFields.Add2 Key:=Range( _
    "E22:E73"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Front Page").Sort
      .SetRange Range("A21:E73")
      .Header = xlYes
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
    End With
    
    Range("A17:AF17").Copy
    Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
  Next X

End Sub

 

[ned lud]

I can't test so pleas try this:

Sub macro1()
' Keyboard Shortcut: Ctrl+a
  Dim X As Long
 
  For X = 1 To 1000
    ActiveWorkbook.Worksheets("Front Page").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Front Page").Sort.SortFields.Add2 Key:=Range( _
    "E22:E73"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Front Page").Sort
      .SetRange Range("A21:E73")
      .Header = xlYes
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
    End With
   
    Range("A17:AF17").Copy
    Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
  Next X

End Sub

You are a god. That worked perfectly. Took about 30 seconds to run - much shorter than I'd have thought.

Thank you very much!