Excel - Changing Cell Color Automatically for Auto Text 1

[hal10000]

Hello,

- I have "First Name" in all A1.

- Cells B15 & C15 use the formula "=UPPER(LEFT(A1,1))" to get the first letter in A1.

- I want the color of the cells B15 & C15 to change automatically depending on the "Upper Case Letter".

- I used the following code (modified from the code I got from this forum) and it is not working in the cells using the formula. BUT IT WORKS IN THE CELLS (without above formula) WHEN I MANUALLY ENTER THE LETTERS.

Any help is greatly appreciated.

HAL

CODE-----

Private Sub Worksheet_Change(ByVal Target As Range)

Dim icolor As Integer

If Not Intersect(Target, Range("A12:J75")) Is Nothing Then

Select Case Target

Case Is = "A"

icolor = 3

Case Is = "B"

icolor = 4

Case Is = "C"

icolor = 6


Case Is = "D"

icolor = 8

Case Is = "E"

icolor = 10

Case Is = "F"

icolor = 12

Case Is = "G"

icolor = 14

Case Is = "H"

icolor = 15

Case Is = "I"

icolor = 18

Case Is = "J"

icolor = 20

Case Is = "K"

icolor = 22

Case Is = "L"

icolor = 24

Case Is = "M"

icolor = 26

Case Is = "N"

icolor = 28

Case Is = "O"

icolor = 30

Case Is = "P"

icolor = 32

Case Is = "Q"

icolor = 34

Case Is = "R"

icolor = 36

Case Is = "S"

icolor = 38

Case Is = "T"

icolor = 40

Case Is = "U"

icolor = 42

Case Is = "V"

icolor = 44

Case Is = "W"

icolor = 46

Case Is = "X"

icolor = 50

Case Is = "Y"

icolor = 48

Case Is = "Z"

icolor = 23

Case Else

'Whatever

End Select



Target.Interior.ColorIndex = icolor

End If



End Sub

 

[SkipVought]

When you have formulas in A12:J75, then only thing changing is when you enter a new value in A1. So the only Target that is changing is outside the A12:J75 range and the Select Case is never executed.

Please expalin what cell values you are entering data in on the sheet and what you are trying to accomplish.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[hal10000]

Hello SkipVought,

- Following is a link to the file

http://www.apexhandtherapy.com/hal.xls

- Entering Data in cells C6:M10 will automatically populate data in cells A12:K70.

- I want the cells A12:B70 & I12:J70 to automatically change color based on the Alphabet.


Thank you,
HAL

 

[SkipVought]

Your source data layout is troubling to me.

Data is normally confiugured...
[tt]
LBL Last_Name First_Name Middle_Name Patient_Number Year
Label_1 Doe John A 16511651 2111
Label_2 Dow Jane c 16919819 2080
Label_3 Xul Mac P 132164851 2091
Label_4 Bee Joe M 5613651 2063
Label_5 Clare Ken M 549684165 2075
Label_6 Tom Mat I 6561513 2083
[/tt]
This is important for a number of reasons, because it is very likely that your list of names will be many more than 6, and you'll want to map the NEXT SIX NAMES into this area, etc. Your transposed layout makes that VERY DIFFICULT!

Then I layed out your labels with Label Name to the left and Field Names above. Field Names are in row 1 above every cell containing that name in a range named NameArea. The lable names are in an adjacent column in every row containing data dor that label in a range named LabelArea.

The source data is in a range named SourceRange.

Then using this layout, my VBA code is...

Function ColorIdx(sByte As String)
        Select Case sByte
            Case Is = "A": ColorIdx = 3
            Case Is = "B": ColorIdx = 4
            Case Is = "C": ColorIdx = 6
            Case Is = "D": ColorIdx = 8
            Case Is = "E": ColorIdx = 10
            Case Is = "F": ColorIdx = 12
            Case Is = "G": ColorIdx = 14
            Case Is = "H": ColorIdx = 15
            Case Is = "I": ColorIdx = 18
            Case Is = "J": ColorIdx = 20
            Case Is = "K": ColorIdx = 22
            Case Is = "L": ColorIdx = 24
            Case Is = "M": ColorIdx = 26
            Case Is = "N": ColorIdx = 28
            Case Is = "O": ColorIdx = 30
            Case Is = "P": ColorIdx = 32
            Case Is = "Q": ColorIdx = 34
            Case Is = "R": ColorIdx = 36
            Case Is = "S": ColorIdx = 38
            Case Is = "T": ColorIdx = 40
            Case Is = "U": ColorIdx = 42
            Case Is = "V": ColorIdx = 44
            Case Is = "W": ColorIdx = 46
            Case Is = "X": ColorIdx = 50
            Case Is = "Y": ColorIdx = 48
            Case Is = "Z": ColorIdx = 23
        End Select
End Function

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sField As String, sLabel As String
    Dim rField As Range, rLabel As Range, rMrg As Range
    If Not Intersect(Target, Range("SourceRange")) Is Nothing Then
        ActiveSheet.Calculate
        sField = Cells(1, Target.Column).Value
        sLabel = Cells(Target.Row, 1).Value
        
        Select Case sField
            Case "Last_Name", "First_Name"
                For Each rField In Range("NameArea")
                    For Each rLabel In Range("LabelArea")
                        Set rMrg = Intersect(rField.EntireColumn, rLabel.EntireRow).MergeArea
                        With rMrg
                            .Interior.ColorIndex = ColorIdx(.Cells(1, 1).Value)
                        End With
                    Next
                Next
        End Select
    End If
End Sub

I'd also be apt to put the Character/ColorIndex data in a table on another sheet.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[hal10000]

Hello SkipVought,

- I realized that storing each persons data in one row was better, but, I felt lazy and moreover, pressing "ENTER" highlights below cell.

- I thought of keeping data entry to "SHEET1" and auto data entry to "SHEET 2" and making only selected area on "SHEET 2" to print. But this is my 2nd or 3rd time using excel and I don't have any VB skills.

- I made the changes you suggested and I am getting Run-time error "1004".

- Following is a link to modified excel file.

http://www.apexhandtherapy.com/hal2.xls

Thank you,

HAL

 

[SkipVought]

"pressing "ENTER" highlights below cell."

Use TAB.

"I made the changes you suggested and I am getting Run-time error "1004"."

Unfortunately, you did not make the changes I suggested. You have absolutely no Named Ranges as mentioned above. Neither do you have the DATA within those ranges, that define the Label and Fields.

You could use ranges to the RIGHT that are for the Labels and Below for Fields. Columns A-E each should have Last_Name in a row (for instance row 72) and First_Name in Columns F-J. This range is NameArea

Rows 12-20 should have Label_1 in a column (for instanve column M) etc. The range is LabelArea

Why do you have the source data in merged cells. BAD PRACTICE??? Merged cells are frought with all kinds of problems. OK for your Labels, thought. The source data range need to be named too as SourceRange.

The code uses the intersection between the Ranges represented by the Heading in your source data...

        sField = Cells([b][red]1[/red][/b], Target.Column).Value
        sLabel = Cells(Target.Row, 1).Value

Since you inexplicably have 4 empty rows above your source data table, the [red]BOLD RED[/red]value, which references the heading row, must be changed

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[hal10000]

Thank you. I am working on it.

Hal

 

[hal10000]

I am hoping that the following file has what you suggested. I moved the auto text part to "SHEET2".

http://www.apexhandtherapy.com/hal3.xls

Thank you,

HAL

 

[SkipVought]

YOU HAVE NO NAMED RANGES!!!

Use Excel HELP!!!

Look for Name - Define named cell references or ranges

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[hal10000]

Color changes are happening in SHEET1 but not SHEET2.


HAL

 

[hal10000]

Color changes are happening in SHEET1 but not SHEET2.

How do I change the "active sheet" to SHEET2?

http://www.apexhandtherapy.com/hal4.xls

HAL

 

[SkipVought]

1) LabelArea SHOULD BE the range of label data on Sheet2

2) NameArea SHOULD BE a range of headings (that you have not yet created) on Sheet2.

In Sheet2!A60:E60 enter Last_Name
In Sheet2!F60:J60 enter First_Name
Name Sheet2!A60:J60 as NameArea

3) SourceRange SHOULD BE Sheet1!A2:E7.

With your labels properly named, there is no need to reference Sheet2. Sheet2 is implied in the range names.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[SkipVought]

Hal FYI,

This post would have been much better served in forum707.

This form is reserved for native MS Office functionality issues while forum707 is designed for VBA code issues in MS Office applications.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}