Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > HUGE macro
 
 
LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 36
Default HUGE macro
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
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 FIVE_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:A6").Select 'COPY RANGE
Selection.Copy
Range("F2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("A7:A10").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_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:A7").Select 'COPY RANGE
Selection.Copy
Range("F2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("A8:A12").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 SEVEN_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:A8").Select 'COPY RANGE
Selection.Copy
Range("F2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("A9:A14").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 SEVEN_ON_SEVEN()
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:A8").Select 'COPY RANGE
Selection.Copy
Range("F2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("A9:A15").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
Reply With QuoteReply With Quote
 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Threaded Mode Threaded Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
Trouble figuring out how to Loop through a huge repetitive macro Don M. Excel Programming 12 November 4th 08 01:08 AM
huge problem tomro1 Excel Discussion (Misc queries) 0 June 13th 06 09:30 AM
huge problem!!! tomro1[_9_] Excel Programming 0 June 12th 06 09:40 PM
A Huge Thank You! Zani Excel Programming 0 March 3rd 06 12:41 AM
huge huge excel file... why? Josh Excel Discussion (Misc queries) 12 February 9th 06 09:55 PM


All times are GMT +1. The time now is 03:44 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement