Visual Basic

[Dan Wood]

I am really struggling to create a macro in VB.

I need to set the macro to colour cells dependant on what character is in
the title cell.

In cells B4 to P4 therewill be characters E, M, L or O
In cells B6 down to B25 and across from there to P625 is a range of cells
that need to be formatted with certain colours. For example if in B4 it says
E i need the cells in B6 to B25 to fill in blue.

I believe i need to set a range of cells, then refer to them to llok
something like this:-

For Each cell In SHIFT_range
Select Case LCase(cell.Value)
Case ""
cell.Interior.ColorIndex = 0
Range(cell.Offset(0, -1), cell.Offset(0,
60)).Interior.ColorIndex = 0

Case "o"
Range(cell, cell.Offset(0, -1)).Interior.ColorIndex = 15
Range(cell.Offset(0, 1), cell.Offset(0, 60)).Interior.ColorIndex
= 0

But as stated above i am really struggling with this. Any help is gratfully
received

 

[Jacob Skaria]

Hi Dan; try the below//

Sub Macro()
Dim colIndex As Variant
For Each cell In Range("B44")
colIndex = Empty
Select Case UCase(cell.Text)
Case "E"
colIndex = 15
Case "M"
colIndex = 3
Case "L"
colIndex = 7
Case "O"
colIndex = 6
End Select

If colIndex = Empty Then colIndex = -4142
Range(Cells(6, cell.Column), Cells(25, _
cell.Column)).Interior.ColorIndex = colIndex
Next
End Sub

If this post helps click Yes

 

[Dan Wood]

I am proberly doing something wrong but its still not working. I have copied
and pasted your suggestion into a module on the spreadsheet. Is this correct?
Do i need to assign it to the sheet?

 

[Jacob Skaria]

If you are looking to run this as a macro then

--Set the Security level to low/medium in (Tools|Macro|Security).
--From workbook launch VBE using short-key Alt+F11.
--From menu 'Insert' a module and paste the below code.
--Get back to Workbook.
--Run macro from Tools|Macro|Run <selected macro()>

If you are looking to run this automatically when you change the value in
Range("B44") then use Worksheet Change event. Right click the Sheet
tab>View Code and paste the below code in the code panel..Get back to
workbook and try changing the values in the range.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim colIndex As Variant

If Not Application.Intersect(Target, Range("B44")) Is Nothing Then
Select Case UCase(Target.Text)
Case "E"
colIndex = 15
Case "M"
colIndex = 3
Case "L"
colIndex = 7
Case "O"
colIndex = 6
End Select

If colIndex = Empty Then colIndex = -4142
Application.EnableEvents = False
Range(Cells(6, Target.Column), Cells(25, _
Target.Column)).Interior.ColorIndex = colIndex
Application.EnableEvents = True
End If
End Sub



If this post helps click Yes

 

[Rick Rothstein]

Probably a little more cryptic than yours, but a little shorter...

Sub ColorColumns()
Dim C As Range
For Each C In Worksheets("Sheet1").Range("B44")
C.Offset(2).Resize(20).Interior.ColorIndex = Choose(InStr(1, _
" EMLO", Left(C.Value & " ", 1), vbTextCompare), _
xlColorIndexNone, 15, 3, 7, 6)
Next
End Sub

 

[Rick Rothstein]

Actually, the code I posted has a defect... it will fail if a letter other
than E, M, L or O is put in the cell. To protect against that possibility,
this code would be better (I think this macro now does what your macro
does)...

Sub ColorColumns()
Dim C As Range, Index As Long
For Each C In Worksheets("Sheet1").Range("B44")
With C.Offset(2).Resize(20).Interior
Index = InStr(1, "EMLO", Left(C.Value & " ", 1), vbTextCompare)
If Index > 0 Then
.ColorIndex = Choose(Index, 15, 3, 7, 6)
Else
.ColorIndex = xlColorIndexNone
End If
End With
Next
End Sub

 

[Joerg Mochikun]

Jacob, are you sure that this code works in a module? Worksheet_Change is a
sheet event, so the OP should better place it into the code section of a
worksheet.

Joerg

 

[Dana DeLouis]

Select Case UCase(Target.Text)

Case "E"
colIndex = 15
Case "M"
colIndex = 3
Case "L"
colIndex = 7
Case "O"
colIndex = 6
End Select

Hi. Just something different ...

S = UCase(Cell.Text)
Select Case S
Case "E", "M", "L", "O"
ColIndex = 30138111 Mod Asc(S) '15,3,7, or 6
End Select

= = = = = =
Dana DeLouis

 

[Jacob Skaria]

Joerg

If the line "--From menu 'Insert' a module and paste the below code." is
casuing confusion; i mean the code which I posted initially Sub Macro()

If this post helps click Yes

 

[Rick Rothstein]

I take this posting back... my originally posted (cryptic) code WORKS
FINE... it DOES NOT fail if a letter different than E, M, L or O is put in
the cell. Even though it was 1:30 in the morning, I should have tested that
original code to see if it worked or not rather than relying on a "guess"
like I did... sorry for any inconvenience.

So, to repeat, the OP can use this code to color his columns (all he has to
do it replace the ColorIndex numbers 15, 3, 7, 6, for the letters E, M, L
and O respectively, with the ColorIndex numbers of his choosing....

Sub ColorColumns()
Dim C As Range
For Each C In Worksheets("Sheet1").Range("B44")
C.Offset(2).Resize(20).Interior.ColorIndex = Choose(InStr(1, _
" EMLO", Left(C.Value & " ", 1), vbTextCompare), _
xlColorIndexNone, 15, 3, 7, 6)
Next
End Sub

 

[Dan Wood]

I am proberly being seriously stupid here but i still can't get it to work. I
have tried all the options listed.

I am opening excel,
Clicking view code,
Opening the module,
Copy and pasting the code,
Closing VB,
Changing the fields

But for some reason there is no change in colour. Is there any more
information i need to give to get this to work?