HELP W/ VBA: SELECT RANGE, ALLCAPS, CELL COLOR, RETURN TO BLANK CELL/PATTERN CELL

E

extremejobtvshow

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.........
 
T

TomPl

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.???

[email protected] said:
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)
Click to expand...
 
E

extremejobtvshow

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.???
Click to expand...

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.
 
R

Rick Rothstein \(MVP - VB\)

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


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.........
Click to expand...
 
E

extremejobtvshow

Are you trying to process only the cell the user has entered data in?
Click to expand...

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.
 
R

Rick Rothstein \(MVP - VB\)

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

VBA limit from sheet to several ranges 2
VBA Code to change color of field based on entry - query also. 0
Q: How to color a cell based on values in two cells 17
Conditional coloring of Excel cells, based on adjacent cell values? 0
Keep contents in clipboard 0
Error on password protected sheet. 2
Worksheet Change event on different ranges with data validation 2
Highlight a cell after update in a specific range 2

Top