| 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 |
|
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
HUGE macro
..Sort.SetRange Range("A1:C20") _
..Header = xlYes, _ ..MatchCase = False, _ ..Orientation = xlTopToBottom, _ ..SortMethod = xlPinYin ..Apply "joel" wrote: 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 |
|
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
HUGE macro
I see what I did wrong. I usually do my sorts a little different then the
wayyou did it. I normally do it in one instruction from ..Sort.SetRange Range("A1:C20") _ ..Header = xlYes, _ ..MatchCase = False, _ ..Orientation = xlTopToBottom, _ ..SortMethod = xlPinYin ..Apply with .Sort .SetRange Range("A1:C20") .Header = xlYes .MatchCase = False .orientation = xlTopToBottom .SortMethod = xlPinYin .Apply end with I usually do it without the with like this. I kind of mixed the 2 methods and got it wrong. .Range("A1:C20").Sort _ Header = xlYes, _ MatchCase = False , _ orientation = xlTopToBottom, _ SortMethod = xlPinYin "project manager" wrote: .Sort.SetRange Range("A1:C20") _ .Header = xlYes, _ .MatchCase = False, _ .Orientation = xlTopToBottom, _ .SortMethod = xlPinYin .Apply "joel" wrote: 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 |
|
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
HUGE macro
now an error on
..FormatConditions(Selection.FormatConditions.Coun t).SetFirstPriority "joel" wrote: I see what I did wrong. I usually do my sorts a little different then the wayyou did it. I normally do it in one instruction from .Sort.SetRange Range("A1:C20") _ .Header = xlYes, _ .MatchCase = False, _ .Orientation = xlTopToBottom, _ .SortMethod = xlPinYin .Apply with .Sort .SetRange Range("A1:C20") .Header = xlYes .MatchCase = False .orientation = xlTopToBottom .SortMethod = xlPinYin .Apply end with I usually do it without the with like this. I kind of mixed the 2 methods and got it wrong. .Range("A1:C20").Sort _ Header = xlYes, _ MatchCase = False , _ orientation = xlTopToBottom, _ SortMethod = xlPinYin "project manager" wrote: .Sort.SetRange Range("A1:C20") _ .Header = xlYes, _ .MatchCase = False, _ .Orientation = xlTopToBottom, _ .SortMethod = xlPinYin .Apply "joel" wrote: 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 |
|
#11
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
HUGE macro
We are close to the end. I fixed this problem once in the code and did see
the problem the 2nd time. I is very tough to make a lot of changes and get it perfect the 1st time. 've done changes like this a lot and usually get it perfect the 1st time. from ..FormatConditions(Selection.FormatConditions.Coun t).SetFirstPriority to ..FormatConditions(.FormatConditions.Count).SetFir stPriority "joel" wrote: I see what I did wrong. I usually do my sorts a little different then the wayyou did it. I normally do it in one instruction from .Sort.SetRange Range("A1:C20") _ .Header = xlYes, _ .MatchCase = False, _ .Orientation = xlTopToBottom, _ .SortMethod = xlPinYin .Apply with .Sort .SetRange Range("A1:C20") .Header = xlYes .MatchCase = False .orientation = xlTopToBottom .SortMethod = xlPinYin .Apply end with I usually do it without the with like this. I kind of mixed the 2 methods and got it wrong. .Range("A1:C20").Sort _ Header = xlYes, _ MatchCase = False , _ orientation = xlTopToBottom, _ SortMethod = xlPinYin "project manager" wrote: .Sort.SetRange Range("A1:C20") _ .Header = xlYes, _ .MatchCase = False, _ .Orientation = xlTopToBottom, _ .SortMethod = xlPinYin .Apply "joel" wrote: 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 |
|
#12
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
HUGE macro
Case 8
Call X_ON_X(4, 4) Case 9 Call X_ON_X(5, 4) Case 10 Call X_ON_X(5, 5) Just an idea. If the op expands the number of inputs, does it follow the same pattern? x = CLng(Range("D1")) 'Make sure it's an integer Select Case x Case 8 To 14 ' or more... Call X_ON_X((x + 1) \ 2, x \ 2) Case Else '?? End Select = = = Dana DeLouis <snip |
|
#13
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
HUGE macro
I think in this case the select statement makes the code much easier to
understand. Reducing the number of lines of code really doesn't have any advantage. "Dana DeLouis" wrote: Case 8 Call X_ON_X(4, 4) Case 9 Call X_ON_X(5, 4) Case 10 Call X_ON_X(5, 5) Just an idea. If the op expands the number of inputs, does it follow the same pattern? x = CLng(Range("D1")) 'Make sure it's an integer Select Case x Case 8 To 14 ' or more... Call X_ON_X((x + 1) \ 2, x \ 2) Case Else '?? End Select = = = Dana DeLouis <snip |
|
#14
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
HUGE macro
its not working at all??? its not sorting, copying or pasting???
i put a break in the first line and F8'ed it through... just nothing "joel" wrote: I think in this case the select statement makes the code much easier to understand. Reducing the number of lines of code really doesn't have any advantage. "Dana DeLouis" wrote: Case 8 Call X_ON_X(4, 4) Case 9 Call X_ON_X(5, 4) Case 10 Call X_ON_X(5, 5) Just an idea. If the op expands the number of inputs, does it follow the same pattern? x = CLng(Range("D1")) 'Make sure it's an integer Select Case x Case 8 To 14 ' or more... Call X_ON_X((x + 1) \ 2, x \ 2) Case Else '?? End Select = = = Dana DeLouis <snip |
|
#15
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
HUGE macro
I'll take a look at this tonight. Usually these problems are when more that
one workbook is opened. the code is using Activeworkbook. Maybe this should be changed to Thisworkbook (the book with the macro) rather than actrtiveworkbook. The other possibility it the range in the Pick_Um code doesn't specify a worksheet. If D1 is 0 the code will not work (wrong workshet selected). You are right the sort should be working which implies it is not reading the value in D1 because the wrong worksheet is active. 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 "project manager" wrote: its not working at all??? its not sorting, copying or pasting??? i put a break in the first line and F8'ed it through... just nothing "joel" wrote: I think in this case the select statement makes the code much easier to understand. Reducing the number of lines of code really doesn't have any advantage. "Dana DeLouis" wrote: Case 8 Call X_ON_X(4, 4) Case 9 Call X_ON_X(5, 4) Case 10 Call X_ON_X(5, 5) Just an idea. If the op expands the number of inputs, does it follow the same pattern? x = CLng(Range("D1")) 'Make sure it's an integer Select Case x Case 8 To 14 ' or more... Call X_ON_X((x + 1) \ 2, x \ 2) Case Else '?? End Select = = = Dana DeLouis <snip |
| 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) | |||
Linear Mode
