football games

P

project manager

i run a six a side football club at work and each week i pick the team and
people moan.

is there a way in excel vba to put 'name in a hat' and generate my teams?

using player 1 - 12 as an example?

thanks in advance...
 
M

Mike H

Hi,

Well I hope you don't select 6 goalkeepers using random selection but to
pick 6 from 12 put the 12 names in column A starting in a1

Put this in b1 and drag down =Rand()

select columns A & B and then

data|Sort - select column B from the dropdown OK

the top 6 in the list in column A are completely random. resort for the next
6.

Mike
 
P

project manager

I've created a monster, is it possible to trim down a tad...

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.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add
Key:=Range("C2:C20") _
, SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:="YES,NO", _
DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.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.FormatConditions.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.FormatConditions.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.FormatConditions.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.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add
Key:=Range("C2:C20") _
, SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:="YES,NO", _
DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.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.FormatConditions.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.FormatConditions.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.FormatConditions.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.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add
Key:=Range("C2:C20") _
, SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:="YES,NO", _
DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.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.FormatConditions.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.FormatConditions.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.FormatConditions.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.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add
Key:=Range("C2:C20") _
, SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:="YES,NO", _
DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.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.FormatConditions.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.FormatConditions.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.FormatConditions.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.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add
Key:=Range("C2:C20") _
, SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:="YES,NO", _
DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.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.FormatConditions.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.FormatConditions.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.FormatConditions.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.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add
Key:=Range("C2:C20") _
, SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:="YES,NO", _
DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.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.FormatConditions.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.FormatConditions.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.FormatConditions.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.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add
Key:=Range("C2:C20") _
, SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:="YES,NO", _
DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.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.FormatConditions.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.FormatConditions.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.FormatConditions.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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top