| Home |
| Search |
| Today's Posts |
|
|
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
HELP W/ VBA: SELECT RANGE, ALLCAPS, CELL COLOR, RETURN TO BLANK CELL/PATTERN CELL
I'm new at this and trying to create a better bit of code to make a
gant style schedule to track projects in Excel. HELP would be very much apreciated: I'm trying to acomplish the following: in a large group of selected multiple (13 -15 ) ranges (but not all of the worksheet): First: user enters text ("PA1", "ae1", "ed2"...etc), Then VBA= 1. convert text to capitals. 2. custom set cell color, font color & bold based on recognising the text ["AE1" = green,bold....]. 3. If the text is deleted the cell should revert to blank - except if column is weekend (sat, sun) in which case it should revert to blank cell with Pattern (8% grey shading). The sheet tracks days in rows across many months. (A1= 8/19, A2= 8/20....) Column lists tasks, cells are coded with people or event as code (production assistant = PA1) Each individual/ event needs own color to sort overlap in concurent project timelines: First I tried this code but I cant limit the Range and it messes up everything else on the worksheet (plus I can't get weekend cells to revert to shaded): Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Not Application.Intersect(Target, Range("c1:IV9999")) Is Nothing Then Target(1).Value = UCase(Target(1).Value) End If Application.EnableEvents = True Dim Cell As Range Dim Rng1 As Range On Error Resume Next Set Rng1 = ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas, 1) On Error GoTo 0 If Rng1 Is Nothing Then Set Rng1 = Range(Target.Address) Else Set Rng1 = Union(Range(Target.Address), Rng1) End If For Each Cell In Rng1 Select Case Cell.Value Case vbNullString Cell.Interior.ColorIndex = xlNone Cell.Font.Bold = False Case "1TR", "1PR", "1S1", "1S2" Cell.Interior.ColorIndex = 37 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "TR", "PR", "S1", "S2" Cell.Interior.ColorIndex = 37 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "PA1" Cell.Interior.ColorIndex = 39 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "PA2" Cell.Interior.ColorIndex = 40 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "PA3" Cell.Interior.ColorIndex = 38 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "AE1" Cell.Interior.ColorIndex = 37 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "AE2" Cell.Interior.ColorIndex = 41 Cell.Font.Bold = True Cell.Font.ColorIndex = 2 Case "AE3" Cell.Interior.ColorIndex = 34 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "AE4" Cell.Interior.ColorIndex = 55 Cell.Font.Bold = True Cell.Font.ColorIndex = 2 Case "ED1" Cell.Interior.ColorIndex = 43 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "ED2" Cell.Interior.ColorIndex = 50 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "ED3" Cell.Interior.ColorIndex = 10 Cell.Font.Bold = True Cell.Font.ColorIndex = 6 Case "ED4" Cell.Interior.ColorIndex = 14 Cell.Font.Bold = True Cell.Font.ColorIndex = 6 Case "WR1" Cell.Interior.ColorIndex = 36 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "VOT" Cell.Interior.ColorIndex = 35 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "VO", "VO1", "VO2", "VO3", "VO4", "VO5", "VO6", "VO7", "VO8", "VO9" Cell.Interior.ColorIndex = 42 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "C", "C1", "C2", "C3", "C4", "C5", "C6", "C7", "C8", "C9", "C10", "C11", "C12", "C13" Cell.Interior.ColorIndex = 45 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "AU", "AU1", "AU2", "AU3", "AU4", "AU5", "AU6", "AU7", "AU8", "AU9", "AU10", "AU11", "AU12", "AU13" Cell.Interior.ColorIndex = 46 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "M", "M1", "M2", "M3", "M4", "M5", "M6", "M7", "M8", "M9", "M10", "M11", "M12", "M13" Cell.Interior.ColorIndex = 53 Cell.Font.Bold = True Cell.Font.ColorIndex = 2 Case "S", "S1", "S2", "S3", "S4", "S5", "S6", "S7", "S8", "S9", "S10", "S11", "S12", "S13", "S14" Cell.Interior.ColorIndex = 10 Cell.Font.Bold = True Cell.Font.ColorIndex = 6 Case "NT", "NT1", "NT2", "NT3", "NT4", "NT5", "NT6", "NT7", "NT8", "NT9", "NT10", "NT11", "NT12", "NT13", "NT14", "NT15" Cell.Interior.ColorIndex = 48 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case Else Cell.Interior.ColorIndex = xlNone Cell.Font.Bold = False End Select Next End Sub Alternately I tried to swap to this into the code but it slowed way down: ........Dim Cell As Range Dim Rng1 As Range Dim r1 As Range, r2 As Range, r3 As Range Set r1 = Range("D10:IV23") Set r2 = Range("D28:IV45") Set r3 = Range("D47:IV50") Set Rng1 = Union(r1, r2, r3) For Each Cell In Rng1......... |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
HELP W/ VBA: SELECT RANGE, ALLCAPS, CELL COLOR, RETURN TO BLANK CE
Maybe I missed something, but it looks like conditional formatting would
solve all but maybe the "All Caps" issue. You could skip the VBA all together.??? " wrote: I'm new at this and trying to create a better bit of code to make a gant style schedule to track projects in Excel. HELP would be very much apreciated: I'm trying to acomplish the following: in a large group of selected multiple (13 -15 ) ranges (but not all of the worksheet): First: user enters text ("PA1", "ae1", "ed2"...etc), Then VBA= 1. convert text to capitals. 2. custom set cell color, font color & bold based on recognising the text ["AE1" = green,bold....]. 3. If the text is deleted the cell should revert to blank - except if column is weekend (sat, sun) in which case it should revert to blank cell with Pattern (8% grey shading). The sheet tracks days in rows across many months. (A1= 8/19, A2= 8/20....) Column lists tasks, cells are coded with people or event as code (production assistant = PA1) Each individual/ event needs own color to sort overlap in concurent project timelines: First I tried this code but I cant limit the Range and it messes up everything else on the worksheet (plus I can't get weekend cells to revert to shaded): Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Not Application.Intersect(Target, Range("c1:IV9999")) Is Nothing Then Target(1).Value = UCase(Target(1).Value) End If Application.EnableEvents = True Dim Cell As Range Dim Rng1 As Range On Error Resume Next Set Rng1 = ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas, 1) On Error GoTo 0 If Rng1 Is Nothing Then Set Rng1 = Range(Target.Address) Else Set Rng1 = Union(Range(Target.Address), Rng1) End If For Each Cell In Rng1 Select Case Cell.Value Case vbNullString Cell.Interior.ColorIndex = xlNone Cell.Font.Bold = False Case "1TR", "1PR", "1S1", "1S2" Cell.Interior.ColorIndex = 37 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "TR", "PR", "S1", "S2" Cell.Interior.ColorIndex = 37 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "PA1" Cell.Interior.ColorIndex = 39 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "PA2" Cell.Interior.ColorIndex = 40 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "PA3" Cell.Interior.ColorIndex = 38 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "AE1" Cell.Interior.ColorIndex = 37 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "AE2" Cell.Interior.ColorIndex = 41 Cell.Font.Bold = True Cell.Font.ColorIndex = 2 Case "AE3" Cell.Interior.ColorIndex = 34 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "AE4" Cell.Interior.ColorIndex = 55 Cell.Font.Bold = True Cell.Font.ColorIndex = 2 Case "ED1" Cell.Interior.ColorIndex = 43 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "ED2" Cell.Interior.ColorIndex = 50 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "ED3" Cell.Interior.ColorIndex = 10 Cell.Font.Bold = True Cell.Font.ColorIndex = 6 Case "ED4" Cell.Interior.ColorIndex = 14 Cell.Font.Bold = True Cell.Font.ColorIndex = 6 Case "WR1" Cell.Interior.ColorIndex = 36 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "VOT" Cell.Interior.ColorIndex = 35 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "VO", "VO1", "VO2", "VO3", "VO4", "VO5", "VO6", "VO7", "VO8", "VO9" Cell.Interior.ColorIndex = 42 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "C", "C1", "C2", "C3", "C4", "C5", "C6", "C7", "C8", "C9", "C10", "C11", "C12", "C13" Cell.Interior.ColorIndex = 45 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "AU", "AU1", "AU2", "AU3", "AU4", "AU5", "AU6", "AU7", "AU8", "AU9", "AU10", "AU11", "AU12", "AU13" Cell.Interior.ColorIndex = 46 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "M", "M1", "M2", "M3", "M4", "M5", "M6", "M7", "M8", "M9", "M10", "M11", "M12", "M13" Cell.Interior.ColorIndex = 53 Cell.Font.Bold = True Cell.Font.ColorIndex = 2 Case "S", "S1", "S2", "S3", "S4", "S5", "S6", "S7", "S8", "S9", "S10", "S11", "S12", "S13", "S14" Cell.Interior.ColorIndex = 10 Cell.Font.Bold = True Cell.Font.ColorIndex = 6 Case "NT", "NT1", "NT2", "NT3", "NT4", "NT5", "NT6", "NT7", "NT8", "NT9", "NT10", "NT11", "NT12", "NT13", "NT14", "NT15" Cell.Interior.ColorIndex = 48 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case Else Cell.Interior.ColorIndex = xlNone Cell.Font.Bold = False End Select Next End Sub Alternately I tried to swap to this into the code but it slowed way down: ........Dim Cell As Range Dim Rng1 As Range Dim r1 As Range, r2 As Range, r3 As Range Set r1 = Range("D10:IV23") Set r2 = Range("D28:IV45") Set r3 = Range("D47:IV50") Set Rng1 = Union(r1, r2, r3) |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
HELP W/ VBA: SELECT RANGE, ALLCAPS, CELL COLOR, RETURN TO BLANKCE
On Jun 27, 6:26*pm, TomPl wrote:
Maybe I missed something, but it looks like conditional formatting would solve all but maybe the "All Caps" issue. *You could skip the VBA all together.??? even with 15 levels of conditional formatting when I'd drag/copy cells I'd loose the formatting or open up holes in the formatting. |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
HELP W/ VBA: SELECT RANGE, ALLCAPS, CELL COLOR, RETURN TO BLANK CELL/ PATTERN CELL
Are you trying to process only the cell the user has entered data in? Or are
you trying to process multiple cells around the user's entry (for example, a range from some start date to an end date)? Rick wrote in message ... I'm new at this and trying to create a better bit of code to make a gant style schedule to track projects in Excel. HELP would be very much apreciated: I'm trying to acomplish the following: in a large group of selected multiple (13 -15 ) ranges (but not all of the worksheet): First: user enters text ("PA1", "ae1", "ed2"...etc), Then VBA= 1. convert text to capitals. 2. custom set cell color, font color & bold based on recognising the text ["AE1" = green,bold....]. 3. If the text is deleted the cell should revert to blank - except if column is weekend (sat, sun) in which case it should revert to blank cell with Pattern (8% grey shading). The sheet tracks days in rows across many months. (A1= 8/19, A2= 8/20....) Column lists tasks, cells are coded with people or event as code (production assistant = PA1) Each individual/ event needs own color to sort overlap in concurent project timelines: First I tried this code but I cant limit the Range and it messes up everything else on the worksheet (plus I can't get weekend cells to revert to shaded): Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Not Application.Intersect(Target, Range("c1:IV9999")) Is Nothing Then Target(1).Value = UCase(Target(1).Value) End If Application.EnableEvents = True Dim Cell As Range Dim Rng1 As Range On Error Resume Next Set Rng1 = ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas, 1) On Error GoTo 0 If Rng1 Is Nothing Then Set Rng1 = Range(Target.Address) Else Set Rng1 = Union(Range(Target.Address), Rng1) End If For Each Cell In Rng1 Select Case Cell.Value Case vbNullString Cell.Interior.ColorIndex = xlNone Cell.Font.Bold = False Case "1TR", "1PR", "1S1", "1S2" Cell.Interior.ColorIndex = 37 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "TR", "PR", "S1", "S2" Cell.Interior.ColorIndex = 37 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "PA1" Cell.Interior.ColorIndex = 39 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "PA2" Cell.Interior.ColorIndex = 40 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "PA3" Cell.Interior.ColorIndex = 38 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "AE1" Cell.Interior.ColorIndex = 37 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "AE2" Cell.Interior.ColorIndex = 41 Cell.Font.Bold = True Cell.Font.ColorIndex = 2 Case "AE3" Cell.Interior.ColorIndex = 34 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "AE4" Cell.Interior.ColorIndex = 55 Cell.Font.Bold = True Cell.Font.ColorIndex = 2 Case "ED1" Cell.Interior.ColorIndex = 43 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "ED2" Cell.Interior.ColorIndex = 50 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "ED3" Cell.Interior.ColorIndex = 10 Cell.Font.Bold = True Cell.Font.ColorIndex = 6 Case "ED4" Cell.Interior.ColorIndex = 14 Cell.Font.Bold = True Cell.Font.ColorIndex = 6 Case "WR1" Cell.Interior.ColorIndex = 36 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "VOT" Cell.Interior.ColorIndex = 35 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "VO", "VO1", "VO2", "VO3", "VO4", "VO5", "VO6", "VO7", "VO8", "VO9" Cell.Interior.ColorIndex = 42 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "C", "C1", "C2", "C3", "C4", "C5", "C6", "C7", "C8", "C9", "C10", "C11", "C12", "C13" Cell.Interior.ColorIndex = 45 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "AU", "AU1", "AU2", "AU3", "AU4", "AU5", "AU6", "AU7", "AU8", "AU9", "AU10", "AU11", "AU12", "AU13" Cell.Interior.ColorIndex = 46 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case "M", "M1", "M2", "M3", "M4", "M5", "M6", "M7", "M8", "M9", "M10", "M11", "M12", "M13" Cell.Interior.ColorIndex = 53 Cell.Font.Bold = True Cell.Font.ColorIndex = 2 Case "S", "S1", "S2", "S3", "S4", "S5", "S6", "S7", "S8", "S9", "S10", "S11", "S12", "S13", "S14" Cell.Interior.ColorIndex = 10 Cell.Font.Bold = True Cell.Font.ColorIndex = 6 Case "NT", "NT1", "NT2", "NT3", "NT4", "NT5", "NT6", "NT7", "NT8", "NT9", "NT10", "NT11", "NT12", "NT13", "NT14", "NT15" Cell.Interior.ColorIndex = 48 Cell.Font.Bold = True Cell.Font.ColorIndex = 1 Case Else Cell.Interior.ColorIndex = xlNone Cell.Font.Bold = False End Select Next End Sub Alternately I tried to swap to this into the code but it slowed way down: ........Dim Cell As Range Dim Rng1 As Range Dim r1 As Range, r2 As Range, r3 As Range Set r1 = Range("D10:IV23") Set r2 = Range("D28:IV45") Set r3 = Range("D47:IV50") Set Rng1 = Union(r1, r2, r3) For Each Cell In Rng1......... |
|
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
HELP W/ VBA: SELECT RANGE, ALLCAPS, CELL COLOR, RETURN TO BLANKCELL/ PATTERN CELL
Are you trying to process only the cell the user has entered data in? Yes and no - currently it processes all cells everywhere, I'd like it to only work in designated areas. It only needs to process one cell at a time. Thanks. |
|
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
HELP W/ VBA: SELECT RANGE, ALLCAPS, CELL COLOR, RETURN TO BLANK CELL/ PATTERN CELL
Give the following a try and see if it does what you want. In it, set your
"designated area" (start row, start/end columns) in the Const statement. Private Sub Worksheet_Change(ByVal Target As Range) Dim C As Range Dim Region As Range Const StartRow As Long = 2 Const StartCol As String = "C" Const EndCol As String = "IV" Set Region = Range(Cells(StartRow, StartCol), Cells(Rows.Count, EndCol)) If Not Intersect(Target, Region) Is Nothing Then With Target Application.EnableEvents = False .Value = UCase(.Value) Application.EnableEvents = True .Font.Bold = True .Font.ColorIndex = 1 Select Case .Value Case vbNullString .Interior.ColorIndex = xlNone .Font.Bold = False .Font.ColorIndex = xlColorIndexAutomatic Case "1TR", "1PR", "1S1", "1S2" .Interior.ColorIndex = 37 Case "TR", "PR", "S1", "S2" .Interior.ColorIndex = 37 Case "PA1" .Interior.ColorIndex = 39 Case "PA2" .Interior.ColorIndex = 40 Case "PA3" .Interior.ColorIndex = 38 Case "AE1" .Interior.ColorIndex = 37 Case "AE2" .Interior.ColorIndex = 41 .Font.ColorIndex = 2 Case "AE3" .Interior.ColorIndex = 34 Case "AE4" .Interior.ColorIndex = 55 .Font.ColorIndex = 2 Case "ED1" .Interior.ColorIndex = 43 Case "ED2" .Interior.ColorIndex = 50 Case "ED3" .Interior.ColorIndex = 10 .Font.ColorIndex = 6 Case "ED4" .Interior.ColorIndex = 14 .Font.ColorIndex = 6 Case "WR1" .Interior.ColorIndex = 36 Case "VOT" .Interior.ColorIndex = 35 Case "VO", "VO1", "VO2", "VO3", "VO4", _ "VO5", "VO6", "VO7", "VO8", "VO9" .Interior.ColorIndex = 42 Case "C", "C1", "C2", "C3", "C4", "C5", "C6", _ "C7", "C8", "C9", "C10", "C11", "C12", "C13" .Interior.ColorIndex = 45 Case "AU", "AU1", "AU2", "AU3", "AU4", "AU5", "AU6", _ "AU7", "AU8", "AU9", "AU10", "AU11", "AU12", "AU13" .Interior.ColorIndex = 46 Case "M", "M1", "M2", "M3", "M4", "M5", "M6", _ "M7", "M8", "M9", "M10", "M11", "M12", "M13" .Interior.ColorIndex = 53 .Font.ColorIndex = 2 Case "S", "S1", "S2", "S3", "S4", "S5", "S6", "S7", _ "S8", "S9", "S10", "S11", "S12", "S13", "S14" .Interior.ColorIndex = 10 .Font.ColorIndex = 6 Case "NT", "NT1", "NT2", "NT3", "NT4", "NT5", "NT6", "NT7", _ "NT8", "NT9", "NT10", "NT11", "NT12", "NT13", "NT14", "NT15" .Interior.ColorIndex = 48 Case Else .Interior.ColorIndex = xlNone .Font.Bold = False .Font.ColorIndex = xlColorIndexAutomatic End Select End With End If End Sub Rick wrote in message ... Are you trying to process only the cell the user has entered data in? Yes and no - currently it processes all cells everywhere, I'd like it to only work in designated areas. It only needs to process one cell at a time. Thanks. |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Return value 1 row above non-blank cell in range | Excel Discussion (Misc queries) | |||
| NEED VBA TO SELECT A CELL; NOTE THE CELL VALUE;COPYADJ CELL;FIND CELL VALUE IN A RANGE AND SO ON | Excel Programming | |||
| Return cell adress for next non-blank cell in a range | Excel Worksheet Functions | |||
| Select last blank cell in a range of data | Excel Programming | |||
| if the value of a cell in a range is not blank, then return the v. | Excel Worksheet Functions | |||
Hybrid Mode
