Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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......... |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
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 |