Thread: HUGE macro
View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Jacob Skaria Jacob Skaria is offline
external usenet poster
  
Posts: 8,520
Default HUGE macro
Would you be able to explain this in few sentences. On an initial look you
can use FOR loop as in the below code to put NO from row 2 to 20.

For intTemp = 2 To 20
Range("C" & intTemp) = "NO"
Next

If this post helps click Yes
---------------
Jacob Skaria


"project manager" wrote:

this is really big, can it be made smaller?

Sub Pick_Um()

Select Case Range("D1").Value
Case 8
Call FOUR_ON_FOUR
Case 9
Call FIVE_ON_FOUR
Case 10
Call FIVE_ON_FIVE
Case 11
Call SIX_ON_FIVE
Case 12
Call SIX_ON_SIX
Case 13
Call SEVEN_ON_SIX
Case 14
Call SEVEN_ON_SEVEN

End Select

End Sub


Sub FIVE_ON_FIVE()
Range("A2:C33").Select
ActiveWindow.SmallScroll Down:=-18
Range("A1:C20").Select
Application.AddCustomList ListArray:=Array("YES", "NO")
ActiveWorkbook.Worksheets("Sheet2").Sort.SortField s.Clear
ActiveWorkbook.Worksheets("Sheet2").Sort.SortField s.Add
Key:=Range("C2:C20") _
, SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:="YES,NO", _
DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet2").Sort.SortField s.Add
Key:=Range("B2:B20") _
, SortOn:=xlSortOnValues, Order:=xlDescending,
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet2").Sort
.SetRange Range("A1:C20")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("F2:G17").Select
Selection.Delete Shift:=xlUp
Range("F2").Select
Range("A2:A6").Select 'COPY RANGE
Selection.Copy
Range("F2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("A7:A11").Select 'COPY RANGE
Application.CutCopyMode = False
Selection.Copy
Range("G2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("F1:F15").Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotEqual, _
Formula1:="="""""""""""""

Selection.FormatConditions(Selection.FormatConditi ons.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Cells.FormatConditions.Delete
Range("F1:F15").Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotEqual, _
Formula1:="=0"

Selection.FormatConditions(Selection.FormatConditi ons.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Range("G1:G14").Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotEqual, _
Formula1:="=0"

Selection.FormatConditions(Selection.FormatConditi ons.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With
ActiveCell.FormulaR1C1 = "NO"
Range("C2").Select
ActiveCell.FormulaR1C1 = "NO"
Range("C3").Select
ActiveCell.FormulaR1C1 = "NO"
Range("C4").Select
ActiveCell.FormulaR1C1 = "NO"
Range("C5").Select
ActiveCell.FormulaR1C1 = "NO"
Range("C6").Select
ActiveCell.FormulaR1C1 = "NO"
Range("C7").Select
ActiveCell.FormulaR1C1 = "NO"
Range("C8").Select
ActiveCell.FormulaR1C1 = "NO"
Range("C9").Select
ActiveCell.FormulaR1C1 = "NO"
Range("C10").Select
ActiveCell.FormulaR1C1 = "NO"
Range("C11").Select
ActiveCell.FormulaR1C1 = "NO"
Range("C12").Select
ActiveCell.FormulaR1C1 = "NO"
Range("C13").Select
ActiveCell.FormulaR1C1 = "NO"
Range("C14").Select
ActiveCell.FormulaR1C1 = "NO"
Range("C15").Select
ActiveCell.FormulaR1C1 = "NO"
Range("C16").Select
ActiveCell.FormulaR1C1 = "NO"
Range("C17").Select
ActiveCell.FormulaR1C1 = "NO"
Range("C18").Select
ActiveCell.FormulaR1C1 = "NO"
Range("C19").Select
ActiveCell.FormulaR1C1 = "NO"
Range("C20").Select
ActiveCell.FormulaR1C1 = "NO"
Range("H1").Select
Application.CutCopyMode = False
End Sub

Sub FOUR_ON_FOUR()
Range("A2:C33").Select
ActiveWindow.SmallScroll Down:=-18
Range("A1:C20").Select
Application.AddCustomList ListArray:=Array("YES", "NO")
ActiveWorkbook.Worksheets("Sheet2").Sort.SortField s.Clear
ActiveWorkbook.Worksheets("Sheet2").Sort.SortField s.Add
Key:=Range("C2:C20") _
, SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:="YES,NO", _
DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet2").Sort.SortField s.Add
Key:=Range("B2:B20") _
, SortOn:=xlSortOnValues, Order:=xlDescending,
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet2").Sort
.SetRange Range("A1:C20")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("F2:G17").Select
Selection.Delete Shift:=xlUp
Range("F2").Select
Range("A2:A5").Select 'COPY RANGE
Selection.Copy
Range("F2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("A6:A9").Select 'COPY RANGE
Application.CutCopyMode = False
Selection.Copy
Range("G2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("F1:F15").Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotEqual, _
Formula1:="="""""""""""""

Selection.FormatConditions(Selection.FormatConditi ons.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Cells.FormatConditions.Delete
Range("F1:F15").Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotEqual, _
Formula1:="=0"

Selection.FormatConditions(Selection.FormatConditi ons.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Range("G1:G14").Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotEqual, _
Formula1:="=0"

Selection.FormatConditions(Selection.FormatConditi ons.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With
ActiveCell.FormulaR1C1 = "NO"
Range("C2").Select
ActiveCell.FormulaR1C1 = "NO"
Range("C3").Select
ActiveCell.FormulaR1C1 = "NO"
Range("C4").Select
ActiveCell.FormulaR1C1 = "NO"
Range("C5").Select
ActiveCell.FormulaR1C1 = "NO"
Range("C6").Select
ActiveCell.FormulaR1C1 = "NO"
Range("C7").Select
ActiveCell.FormulaR1C1 = "NO"
Range("C8").Select
ActiveCell.FormulaR1C1 = "NO"
Range("C9").Select
ActiveCell.FormulaR1C1 = "NO"
Range("C10").Select
ActiveCell.FormulaR1C1 = "NO"
Range("C11").Select
ActiveCell.FormulaR1C1 = "NO"
Range("C12").Select
ActiveCell.FormulaR1C1 = "NO"
Range("C13").Select
ActiveCell.FormulaR1C1 = "NO"
Range("C14").Select
ActiveCell.FormulaR1C1 = "NO"
Range("C15").Select
ActiveCell.FormulaR1C1 = "NO"
Range("C16").Select
ActiveCell.FormulaR1C1 = "NO"
Range("C17").Select
ActiveCell.FormulaR1C1 = "NO"
Range("C18").Select
ActiveCell.FormulaR1C1 = "NO"
Range("C19").Select
ActiveCell.FormulaR1C1 = "NO"
Range("C20").Select
ActiveCell.FormulaR1C1 = "NO"
Range("H1").Select
Application.CutCopyMode = False
End Sub

Sub SIX_ON_SIX()
Range("A2:C33").Select
ActiveWindow.SmallScroll Down:=-18
Range("A1:C20").Select
Application.AddCustomList ListArray:=Array("YES", "NO")
ActiveWorkbook.Worksheets("Sheet2").Sort.SortField s.Clear
ActiveWorkbook.Worksheets("Sheet2").Sort.SortField s.Add
Key:=Range("C2:C20") _
, SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:="YES,NO", _
DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet2").Sort.SortField s.Add
Key:=Range("B2:B20") _
, SortOn:=xlSortOnValues, Order:=xlDescending,
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet2").Sort
.SetRange Range("A1:C20")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("F2:G17").Select
Selection.Delete Shift:=xlUp
Range("F2").Select
Range("A2:A7").Select 'COPY RANGE
Selection.Copy
Range("F2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("A8:A13").Select 'COPY RANGE
Application.CutCopyMode = False
Selection.Copy
Range("G2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("F1:F15").Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotEqual, _
Formula1:="="""""""""""""

Selection.FormatConditions(Selection.FormatConditi ons.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
Reply With QuoteReply With Quote