ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   HELP W/ VBA: SELECT RANGE, ALLCAPS, CELL COLOR, RETURN TO BLANK CELL/PATTERN CELL (https://www.excelbanter.com/excel-programming/413253-help-w-vba-select-range-allcaps-cell-color-return-blank-cell-pattern-cell.html)

[email protected]
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.........

TomPl
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)

[email protected]
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.

Rick Rothstein \(MVP - VB\)[_2196_]
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.........

[email protected]
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.

Rick Rothstein \(MVP - VB\)[_2198_]
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.



All times are GMT +1. The time now is 10:13 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com