| Home |
| Search |
| Today's Posts |
|
|
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
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 |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
HUGE macro
its to pick a team, so when the number of players in a list is 9 it randomly
sorts the list and copys and paste the names in the team colour list, the only different in the FIVE_ON_FIVE and SIX_ON_FIVE is the size of the copy and paste range. d1 is the count of the number of players. "Jacob Skaria" wrote: 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 |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
HUGE macro
|
|
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
HUGE macro
I improved the code and combined the macro into two macros.
Sub Pick_Um() Select Case Range("D1").Value Case 8 Call X_ON_X(4, 4) Case 9 Call X_ON_X(5, 4) Case 10 Call X_ON_X(5, 5) Case 11 Call X_ON_X(6, 5) Case 12 Call X_ON_X(6, 6) Case 13 Call X_ON_X(7, 6) Case 14 Call X_ON_X(7, 7) End Select End Sub Sub X_ON_X(FirstSize As Integer, SecondSize As Integer) Application.AddCustomList ListArray:=Array("YES", "NO") With ActiveWorkbook.Worksheets("Sheet2") .Sort.SortFields.Clear .Sort.SortFields.Add _ Key:=Range("C2:C20"), _ SortOn:=xlSortOnValues, _ Order:=xlAscending, _ CustomOrder:="YES,NO", _ DataOption:=xlSortNormal .Sort.SortFields.Add _ Key:=Range("B2:B20"), _ SortOn:=xlSortOnValues, _ Order:=xlDescending, _ DataOption:=xlSortNormal .Sort.SetRange Range("A1:C20") _ .Header = xlYes, _ .MatchCase = False, _ .Orientation = xlTopToBottom, _ .SortMethod = xlPinYin .Apply .Range("F2:G17").Delete Shift:=xlUp .Range("A2:A" & (FirstSize + 1)).Copy .Range("F2").PasteSpecial _ Paste:=xlPasteValues .Range("A" & (FirstSize + 2) & ":A" & (FirstSize + SecondSize + 1)).Copy .Range("G2").PasteSpecial _ Paste:=xlPasteValues .Cells.FormatConditions.Delete With .Range("F1:F15") .FormatConditions.Add _ Type:=xlCellValue, _ Operator:=xlNotEqual, _ Formula1:="=0" .FormatConditions(.FormatConditions.Count).SetFirs tPriority With .FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .Color = 255 .TintAndShade = 0 End With .FormatConditions(1).StopIfTrue = False End With With Range("G1:G14") .FormatConditions.Add _ Type:=xlCellValue, _ Operator:=xlNotEqual, _ Formula1:="=0" .FormatConditions(Selection.FormatConditions.Count ).SetFirstPriority With .FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 End With End With .Range("C1:C20") = "NO" End With End Sub "project manager" wrote: its to pick a team, so when the number of players in a list is 9 it randomly sorts the list and copys and paste the names in the team colour list, the only different in the FIVE_ON_FIVE and SIX_ON_FIVE is the size of the copy and paste range. d1 is the count of the number of players. "Jacob Skaria" wrote: 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 |
|
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
HUGE macro
it comes up with an errir when i run it.
"joel" wrote: I improved the code and combined the macro into two macros. Sub Pick_Um() Select Case Range("D1").Value Case 8 Call X_ON_X(4, 4) Case 9 Call X_ON_X(5, 4) Case 10 Call X_ON_X(5, 5) Case 11 Call X_ON_X(6, 5) Case 12 Call X_ON_X(6, 6) Case 13 Call X_ON_X(7, 6) Case 14 Call X_ON_X(7, 7) End Select End Sub Sub X_ON_X(FirstSize As Integer, SecondSize As Integer) Application.AddCustomList ListArray:=Array("YES", "NO") With ActiveWorkbook.Worksheets("Sheet2") .Sort.SortFields.Clear .Sort.SortFields.Add _ Key:=Range("C2:C20"), _ SortOn:=xlSortOnValues, _ Order:=xlAscending, _ CustomOrder:="YES,NO", _ DataOption:=xlSortNormal .Sort.SortFields.Add _ Key:=Range("B2:B20"), _ SortOn:=xlSortOnValues, _ Order:=xlDescending, _ DataOption:=xlSortNormal .Sort.SetRange Range("A1:C20") _ .Header = xlYes, _ .MatchCase = False, _ .Orientation = xlTopToBottom, _ .SortMethod = xlPinYin .Apply .Range("F2:G17").Delete Shift:=xlUp .Range("A2:A" & (FirstSize + 1)).Copy .Range("F2").PasteSpecial _ Paste:=xlPasteValues .Range("A" & (FirstSize + 2) & ":A" & (FirstSize + SecondSize + 1)).Copy .Range("G2").PasteSpecial _ Paste:=xlPasteValues .Cells.FormatConditions.Delete With .Range("F1:F15") .FormatConditions.Add _ Type:=xlCellValue, _ Operator:=xlNotEqual, _ Formula1:="=0" .FormatConditions(.FormatConditions.Count).SetFirs tPriority With .FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .Color = 255 .TintAndShade = 0 End With .FormatConditions(1).StopIfTrue = False End With With Range("G1:G14") .FormatConditions.Add _ Type:=xlCellValue, _ Operator:=xlNotEqual, _ Formula1:="=0" .FormatConditions(Selection.FormatConditions.Count ).SetFirstPriority With .FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 End With End With .Range("C1:C20") = "NO" End With End Sub "project manager" wrote: its to pick a team, so when the number of players in a list is 9 it randomly sorts the list and copys and paste the names in the team colour list, the only different in the FIVE_ON_FIVE and SIX_ON_FIVE is the size of the copy and paste range. d1 is the count of the number of players. "Jacob Skaria" wrote: 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 |
|
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
HUGE macro
Which line of code is highlighted when the error occurs?
"project manager" wrote: it comes up with an errir when i run it. "joel" wrote: I improved the code and combined the macro into two macros. Sub Pick_Um() Select Case Range("D1").Value Case 8 Call X_ON_X(4, 4) Case 9 Call X_ON_X(5, 4) Case 10 Call X_ON_X(5, 5) Case 11 Call X_ON_X(6, 5) Case 12 Call X_ON_X(6, 6) Case 13 Call X_ON_X(7, 6) Case 14 Call X_ON_X(7, 7) End Select End Sub Sub X_ON_X(FirstSize As Integer, SecondSize As Integer) Application.AddCustomList ListArray:=Array("YES", "NO") With ActiveWorkbook.Worksheets("Sheet2") .Sort.SortFields.Clear .Sort.SortFields.Add _ Key:=Range("C2:C20"), _ SortOn:=xlSortOnValues, _ Order:=xlAscending, _ CustomOrder:="YES,NO", _ DataOption:=xlSortNormal .Sort.SortFields.Add _ Key:=Range("B2:B20"), _ SortOn:=xlSortOnValues, _ Order:=xlDescending, _ DataOption:=xlSortNormal .Sort.SetRange Range("A1:C20") _ .Header = xlYes, _ .MatchCase = False, _ .Orientation = xlTopToBottom, _ .SortMethod = xlPinYin .Apply .Range("F2:G17").Delete Shift:=xlUp .Range("A2:A" & (FirstSize + 1)).Copy .Range("F2").PasteSpecial _ Paste:=xlPasteValues .Range("A" & (FirstSize + 2) & ":A" & (FirstSize + SecondSize + 1)).Copy .Range("G2").PasteSpecial _ Paste:=xlPasteValues .Cells.FormatConditions.Delete With .Range("F1:F15") .FormatConditions.Add _ Type:=xlCellValue, _ Operator:=xlNotEqual, _ Formula1:="=0" .FormatConditions(.FormatConditions.Count).SetFirs tPriority With .FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .Color = 255 .TintAndShade = 0 End With .FormatConditions(1).StopIfTrue = False End With With Range("G1:G14") .FormatConditions.Add _ Type:=xlCellValue, _ Operator:=xlNotEqual, _ Formula1:="=0" .FormatConditions(Selection.FormatConditions.Count ).SetFirstPriority With .FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 End With End With .Range("C1:C20") = "NO" End With End Sub "project manager" wrote: its to pick a team, so when the number of players in a list is 9 it randomly sorts the list and copys and paste the names in the team colour list, the only different in the FIVE_ON_FIVE and SIX_ON_FIVE is the size of the copy and paste range. d1 is the count of the number of players. "Jacob Skaria" wrote: 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 |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Trouble figuring out how to Loop through a huge repetitive macro | Excel Programming | |||
| huge problem | Excel Discussion (Misc queries) | |||
| huge problem!!! | Excel Programming | |||
| A Huge Thank You! | Excel Programming | |||
| huge huge excel file... why? | Excel Discussion (Misc queries) | |||
Hybrid Mode
