Loop a specific number of times

[andy]

Hi,

I have been reading the threads on looping and I can't find an answer to
this: how can I loop a specific number of times? I have a macro that I
repeat daily but on Fridays I need to do the same macro for Fri, Sat, Sun,
and possibly any holidays on Mon. I have a WORKDAY formula that tells me how
many days I need to repeat the process (3 for a normal weekend, 4 if there is
a holiday on Mon).

Here is my current VBA for the weekend that only does 3 days:

Rows("7:11").Select
Selection.Copy
Range("A6:A20").Select
Selection.Insert Shift:=xlDown
'Clears memo#, income, and any messages
Range("B6:B20,M6:M20,P620").Select
Selection.ClearContents
'Changes the color of Saturday to red
Range("G11:I15").Select
Selection.Font.ColorIndex = 3
'Saturday
Selection.FormulaArray = "=TODAY()+1"
Range("G16:I20").Select
'Sunday
Selection.FormulaArray = "=TODAY()+2"
Range("M21").Select
ActiveCell = "Prepared By: " & Application.UserName
Rows("22:22").Select
Selection.Insert Shift:=xlDown
Range("M6").Select

Is there a 'smart' loop that knows how many days to copy the selected
information contained in rows 7:11?

Thanks!

 

[Bernard Liengme]

A FOR structure is used when you know the number of times you want to repeat
an operation

For J = to 10
do this
do that
Next J


Sorry, I do not have time to put this in the context of what you already
have. See if it helps and them come back with more questions
best wishes

 

[john]

bit of a stab in the dark but see if following gives some ideas how to solve
your problems.
You will note that I have removed all the "select" statements ascyou rarely
need to do this.

Sub loopData()
Dim Mysheet As Worksheet
Dim MyRange As Range

Set Mysheet = ThisWorkbook.Worksheets("Sheet1") '<< change sheet name
'as required

With Mysheet

'get range where number of days stored
Set MyRange = .Range("D1") '<< change range as required

'check value not empty
If MyRange.Value <> "" Then


For na = 1 To MyRange.Value

.Rows("7:11").Copy

.Range("A6:A20").Insert Shift:=xlDown

'Clears memo#, income, and any messages
.Range("B6:B20,M6:M20,P620").ClearContents

'Changes the color of Saturday to red
With .Range("G11:I15")

.Font.ColorIndex = 3
'Saturday
.FormulaArray = "=TODAY()+1"

End With

'Sunday
.Range("G16:I20").FormulaArray = "=TODAY()+2"


.Range("M21").Value = "Prepared By: " & Application.UserName


.Rows("22:22").Insert Shift:=xlDown

Next na

Else

MsgBox "No Value Set In Range"

End If

End With

End Sub