VBA loop with step / incrament

Abvlecxe

Board Regular
Joined
Sep 10, 2015
Messages
53
Hi I have the following code below which works but as you can see is very manual in terms of the loop until the input entry is correct. Basically I want the code to check that the number the user has entered equals 19 or any row number from 19 with a step /increment of 7 e.g. 26,33,40 etc. up to a maximum of 1002 so in effect my validation range is 19 to 1002, with step of 7 from 19

Any help would be appreciated, thanks.


sub InsertRows()

Dim lastRow As Long
Dim Row1 As Long
Dim Row2 As Long
Dim myvalue As Variant
Dim i As Long
Dim CancelTest As Variant
Dim Row As Range
Dim myPassword As String
myPassword = "Password101"

Application.ScreenUpdating = False

lastRow = 0
Do
myvalue = InputBox("Insert Rows Starting From Input Number:" & Chr(10) & _
"e.g. 19, 26, 33 (Multiples of 7)")
If StrPtr(myvalue) = 0 Then Exit Sub
If Not IsNumeric(myvalue) Then MsgBox "Numeric Values Only" & Chr(10) & _
"Starting From Row 19 In Multiples Of 7"
Loop Until Val(myvalue) = 19 Or myvalue = 26 Or myvalue = 33 Or myvalue = 40 Or myvalue = 47 Or myvalue = 54 Or myvalue = 61 Or myvalue = 68 Or myvalue = 75 Or myvalue = 82 Or myvalue = 89 Or myvalue = 96 _
Or myvalue = 103
If MsgBox("Are you sure?", vbYesNo) = vbNo Then Exit Sub
With Sheet1
.Select
.Unprotect Password:=myPassword

ActiveSheet.Outline.ShowLevels RowLevels:=2

lastRow = Cells(Rows.Count, "B").End(xlUp).Row
Row1 = lastRow - 6
Row2 = lastRow
Rows(Row1 & ":" & Row2).Select
Selection.Copy
End With

With Sheet1
.Select
Range("a" & myvalue).Select
Selection.Insert Shift:=xlDown
On Error GoTo 0
Application.CutCopyMode = False
lastRow = 0
.Range("c11").Select
.Protect Password:=myPassword, AllowFiltering:=True, AllowFormattingCells:=True, DrawingObjects:=False, Contents:=True, UserInterfaceOnly:=True, AllowFormattingRows:=True, AllowFormattingColumns:=True

End With
Application.ScreenUpdating = True
End Sub
 
Last edited:

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
Maybe this:

Code:
Loop Until (myvalue = 19 Or (myvalue - 19) Mod 7 = 0) And myvalue <= 1002
 
Upvote 0
Actually there is an error with this code, It allows entry of the number 12 but 19 should b the minimum number allowed, any ideas?

Maybe this:

Code:
Loop Until (myvalue = 19 Or (myvalue - 19) Mod 7 = 0) And myvalue <= 1002
 
Upvote 0
Oooh that looks it works, thanks very much.

One question, why the part (my value -19) ?


The Mod operator gives the remainder of a division.
Example:
15 mod 7 is 1, because 15 divided by 7 is 2 & give a remainder of 1.
14 mod 7 is 0, means no remainder.

why the part (my value -19) ?
because you start at 19 and then add 7 onward so you get 26,33,40 etc.
so for example:
(33-19) Mod 7 is 0, so it will meet the requirement of (myvalue - 19) Mod 7 = 0)
 
Upvote 0
Thanks for taking the time to explain the code.

I think I have managed to fix the issue mentioned above where the code allows the number 12 by adding "And myvalue >=19" at the end of your code.

Cheers

=Akuini;5180674]The Mod operator gives the remainder of a division.
Example:
15 mod 7 is 1, because 15 divided by 7 is 2 & give a remainder of 1.
14 mod 7 is 0, means no remainder.

why the part (my value -19) ?
because you start at 19 and then add 7 onward so you get 26,33,40 etc.
so for example:
(33-19) Mod 7 is 0, so it will meet the requirement of (myvalue - 19) Mod 7 = 0)[/QUOTE]
 
Upvote 0
Actually there is an error with this code, It allows entry of the number 12 but 19 should b the minimum number allowed, any ideas?
Ah, you're right, try this one:

Code:
Loop Until (myvalue - 19) Mod 7 = 0 And myvalue <= 1002 And myvalue >= 19
 
Upvote 0
You're welcome :)

Hi @Akuini you helped me a while back regarding a loop issue as per above chat. I used your mod suggestion but settled on the below code, basically i have a userform so the user can enter what section on a spreadsheet they want to delete, a section comes in blocks of 7 rows starting from row 12 so for example the first section would be rows 12 to 18 and then in multiples of 7 so the next section is rows 19 to 25.

But when i use the userform box and enter the numbers 96 & 102 to delete this section i get the error "Delete End Row Cannot be Before Delete Start Row" and i can't for the life of me work it out as 96 "Delete Start" and 102 "Delete End" should be fine as it is a legitimate start and end point for a section and 102 is larger than 96, any ideas?

I know my code may be a bit long winded but i'm a newbie so i like to lay out in stages until i get better and can write more efficient code

Private Sub cmdyesdelete_Click()


Dim lastRow As Long
Dim Row1 As Long
Dim Row2 As Long
Dim myvalue As Variant
Dim myvalue2 As Variant
Dim i As Long
Dim CancelTest As Variant
Dim Row As Range
Dim myPassword As String
myPassword = "Pass1"

Application.ScreenUpdating = False


With Sheet1
.Select
.Protect Password:=myPassword, AllowFiltering:=True, AllowFormattingCells:=True, DrawingObjects:=False, Contents:=True, UserInterfaceOnly:=True, AllowFormattingRows:=True, AllowFormattingColumns:=True
End With


If Trim(txtdltfrom.Value > txtdltto.Value) Then
MsgBox "Delete End Row Cannot be Before Delete Start Row"
txtdltto.SetFocus
Exit Sub
End If


If Trim(txtdltfrom.Value = "") Then
MsgBox "Please enter: Delete Start Row"
txtdltfrom.SetFocus
Exit Sub
End If


If Trim(txtdltto.Value = "") Then
MsgBox "Please enter: Delete End Row"
txtdltto.SetFocus
Exit Sub
End If


If Not IsNumeric(txtdltfrom) Then
MsgBox "Numeric Values Only"
Exit Sub
End If

If Not IsNumeric(txtdltto) Then
MsgBox "Numeric Values Only"
Exit Sub
End If

'Delete From'
If Trim(txtdltfrom.Value < 12) Then
MsgBox "Delete Start From Row 12 in Multiples of 7"
txtdltfrom.SetFocus
Exit Sub
End If


If Trim(txtdltfrom.Value - 12) Mod 7 <> 0 Then
MsgBox "Delete Start From Row 12 in Multiples of 7"
txtdltfrom.SetFocus
Exit Sub
End If

'Delete To'
If Trim(txtdltto.Value < 18) Then
MsgBox "Delete End From Row 18 in Multiples of 7"
txtdltto.SetFocus
Exit Sub
End If

If Trim(txtdltto.Value - 18) Mod 7 <> 0 Then
MsgBox "Delete Start From Row 18 in Multiples of 7"
txtdltfrom.SetFocus
Exit Sub
End If

If MsgBox("Are you sure?", vbYesNo) = vbNo Then Exit Sub

myvalue = txtdltfrom.Value
myvalue2 = txtdltto.Value

With Sheet1
.Select
.Unprotect Password:=myPassword

ActiveSheet.Outline.ShowLevels RowLevels:=2

lastRow = Cells(Rows.Count, "B").End(xlUp).Row
Row1 = myvalue
Row2 = myvalue2
Rows(Row1 & ":" & Row2).Select
Selection.Delete
End With

With Sheet1
.Select
.Range("c11").Select
.Protect Password:=myPassword, AllowFiltering:=True, AllowFormattingCells:=True, DrawingObjects:=False, Contents:=True, UserInterfaceOnly:=True, AllowFormattingRows:=True, AllowFormattingColumns:=True

End With

'clear the data
txtdltfrom.Value = ""
txtdltto.Value = ""
txtdltfrom.SetFocus
Application.ScreenUpdating = True

Unload Me
End Sub
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,251
Members
448,556
Latest member
peterhess2002

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top