LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 4
Default 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.........

 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Return value 1 row above non-blank cell in range Mifty Excel Discussion (Misc queries) 4 May 12th 08 09:51 PM
NEED VBA TO SELECT A CELL; NOTE THE CELL VALUE;COPYADJ CELL;FIND CELL VALUE IN A RANGE AND SO ON CAPTGNVR Excel Programming 2 July 8th 07 04:18 PM
Return cell adress for next non-blank cell in a range toreadore Excel Worksheet Functions 1 June 28th 06 12:37 PM
Select last blank cell in a range of data DJ Dusty[_2_] Excel Programming 4 March 8th 06 05:23 PM
if the value of a cell in a range is not blank, then return the v. kvail Excel Worksheet Functions 2 April 8th 05 10:07 PM


All times are GMT +1. The time now is 01:53 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"