How can I streamline this repetitious piece of code?

[Father Guido]

You'll note that 95% of the code is repeated with just a single
change per section. I simply change the comparator to evaluate
the data 4 times as shown below.

5000
10000
25000
50000

How can I streamline this code to use a loop and change
the comparator value to each of the 4 values above, rather
than repeating the entire code 4 times with one change each?

Thanks!!!

Norm
______________________________________________

Sub Separate_Sales()
Application.ScreenUpdating = False

' separates sales > $5000
Range("G1").Select
Selection.EntireColumn.Clear
Range("F65356").Select
Selection.End(xlUp).Select
ActiveCell.Offset(0, 1).Select
Do Until ActiveCell.Row = 1
If ActiveCell.Offset(0, -1).Value > 5000 Then
ActiveCell.Value = 1
End If
ActiveCell.Offset(-1, 0).Select
Loop
Range("H1").Select
Selection.EntireColumn.Clear
Range("F65356").Select
Selection.End(xlUp).Select
ActiveCell.Offset(0, 2).Select
Do Until ActiveCell.Row = 1
If ActiveCell.Offset(-1, -1) = 1 And ActiveCell.Offset(0, -1) = ""
Then
ActiveCell.Value = 1
End If
ActiveCell.Offset(-1, 0).Select
Loop
Range("H65356").Select
Selection.End(xlUp).Select
Do Until ActiveCell.Row = 1
If ActiveCell.Value = 1 Then
ActiveCell.EntireRow.Insert
ActiveCell.EntireRow.Insert
End If
ActiveCell.Offset(-1, 0).Select
Loop

' separates sales > $10000
Range("G1").Select
Selection.EntireColumn.Clear
Range("F65356").Select
Selection.End(xlUp).Select
ActiveCell.Offset(0, 1).Select
Do Until ActiveCell.Row = 1
If ActiveCell.Offset(0, -1).Value > 10000 Then
ActiveCell.Value = 1
End If
ActiveCell.Offset(-1, 0).Select
Loop
Range("H1").Select
Selection.EntireColumn.Clear
Range("F65356").Select
Selection.End(xlUp).Select
ActiveCell.Offset(0, 2).Select
Do Until ActiveCell.Row = 1
If ActiveCell.Offset(-1, -1) = 1 And ActiveCell.Offset(0, -1) = ""
Then
ActiveCell.Value = 1
End If
ActiveCell.Offset(-1, 0).Select
Loop
Range("H65356").Select
Selection.End(xlUp).Select
Do Until ActiveCell.Row = 1
If ActiveCell.Value = 1 Then
ActiveCell.EntireRow.Insert
ActiveCell.EntireRow.Insert
End If
ActiveCell.Offset(-1, 0).Select
Loop

' separates sales > $25000
Range("G1").Select
Selection.EntireColumn.Clear
Range("F65356").Select
Selection.End(xlUp).Select
ActiveCell.Offset(0, 1).Select
Do Until ActiveCell.Row = 1
If ActiveCell.Offset(0, -1).Value > 25000 Then
ActiveCell.Value = 1
End If
ActiveCell.Offset(-1, 0).Select
Loop
Range("H1").Select
Selection.EntireColumn.Clear
Range("F65356").Select
Selection.End(xlUp).Select
ActiveCell.Offset(0, 2).Select
Do Until ActiveCell.Row = 1
If ActiveCell.Offset(-1, -1) = 1 And ActiveCell.Offset(0, -1) = ""
Then
ActiveCell.Value = 1
End If
ActiveCell.Offset(-1, 0).Select
Loop
Range("H65356").Select
Selection.End(xlUp).Select
Do Until ActiveCell.Row = 1
If ActiveCell.Value = 1 Then
ActiveCell.EntireRow.Insert
ActiveCell.EntireRow.Insert
End If
ActiveCell.Offset(-1, 0).Select
Loop

' separates sales > $50000
Range("G1").Select
Selection.EntireColumn.Clear
Range("F65356").Select
Selection.End(xlUp).Select
ActiveCell.Offset(0, 1).Select
Do Until ActiveCell.Row = 1
If ActiveCell.Offset(0, -1).Value > 50000 Then
ActiveCell.Value = 1
End If
ActiveCell.Offset(-1, 0).Select
Loop
Range("H1").Select
Selection.EntireColumn.Clear
Range("F65356").Select
Selection.End(xlUp).Select
ActiveCell.Offset(0, 2).Select
Do Until ActiveCell.Row = 1
If ActiveCell.Offset(-1, -1) = 1 And ActiveCell.Offset(0, -1) = ""
Then
ActiveCell.Value = 1
End If
ActiveCell.Offset(-1, 0).Select
Loop
Range("H65356").Select
Selection.End(xlUp).Select
Do Until ActiveCell.Row = 1
If ActiveCell.Value = 1 Then
ActiveCell.EntireRow.Insert
ActiveCell.EntireRow.Insert
End If
ActiveCell.Offset(-1, 0).Select
Loop

Range("G:H").Select
Selection.EntireColumn.Clear
End Sub

 

[Guest]

varr = array(5000,10000,25000,50000)

for i = lbound(varr) to ubound(varr)
valtoCheckAgainst = varr(i)
if something < valtoCheckAgainst then

exit for
end if
Next

 

[Father Guido]

Thanks for the speedy reply Tom, but I'm not quite sure what
to do with your code. I think the first 3 lines go at the top of my
code, and I change 5000 to valtoCheckAgainst, but where in my
code should I place the exit for, end if, and Next please?

Thanks,

Norm
____________________________________________________

varr = array(5000,10000,25000,50000)

for i = lbound(varr) to ubound(varr)
valtoCheckAgainst = varr(i)
if something < valtoCheckAgainst then

exit for
end if
Next
___________________________________________________

Sub Separate_Sales()
Application.ScreenUpdating = False

varr = array(5000,10000,25000,50000)

for i = lbound(varr) to ubound(varr)
valtoCheckAgainst = varr(i)

' separates sales into <$5000, <$1000, <$25000, <$50000
Range("G1").Select
Selection.EntireColumn.Clear
Range("F65356").Select
Selection.End(xlUp).Select
ActiveCell.Offset(0, 1).Select
Do Until ActiveCell.Row = 1
If ActiveCell.Offset(0, -1).Value < valtoCheckAgainst Then
ActiveCell.Value = 1
End If
ActiveCell.Offset(-1, 0).Select
Loop
Range("H1").Select
Selection.EntireColumn.Clear
Range("F65356").Select
Selection.End(xlUp).Select
ActiveCell.Offset(0, 2).Select
Do Until ActiveCell.Row = 1
If ActiveCell.Offset(-1, -1) = 1 And ActiveCell.Offset(0, -1) = ""
Then
ActiveCell.Value = 1
End If
ActiveCell.Offset(-1, 0).Select
Loop
Range("H65356").Select
Selection.End(xlUp).Select
Do Until ActiveCell.Row = 1
If ActiveCell.Value = 1 Then
ActiveCell.EntireRow.Insert
ActiveCell.EntireRow.Insert
End If
ActiveCell.Offset(-1, 0).Select
Loop

Range("G:H").Select
Selection.EntireColumn.Clear
End Sub