View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Tom Ogilvy Tom Ogilvy is offline
external usenet poster
 
Posts: 6,953
Default How can I streamline this repetitious piece of code?

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

--
Regards,
Tom Ogilvy

"Father Guido" wrote:

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