Multi conditions in Case to trigger cells change

[Vincent88]

Hi Guys,
I use this code to make cells change but I feel the Case is too chunky. Can anyone help to make it more neatly. Basically the following conditions trigger the change to happen :
Conditions to trigger the event
firstcell value and secondcell value

Cells values
firstcell value = ("E") or ("N")
secondcell value =("D", "D1", "D2", "D3", "D4", "D5", "G", "K")

and

firstcell value =("N")
secondcell value =("E")

Sub PairedCell3()

Application.DisplayStatusBar = False
Application.EnableEvents = False
Application.ScreenUpdating = False

Dim C As Range, rng As Range, rng1 As Range
Set rng = Range("C3", Range("AL" & Rows.Count).End(xlUp))

With rng.Borders
    .LineStyle = xlContinuous
    .Weight = xlThin
End With

'Make Target and Adjacent Cells Change
For Each C In rng
               Case "ED", "ED1", "ED2", "ED3", "ED4", "ED5", "EG", "EK", _
                "ND", "ND1", "ND2", "ND3", "ND4", "ND5", "NE", "NG", "NK"
                    With C.Resize(, 2)
                        .Borders.LineStyle = xlContinuous
                        .Borders.Weight = xlThick
                        .Borders.Color = RGB(102, 0, 255)
                    End With
                End Select
Next C
Application.DisplayStatusBar = True
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

 

[Joe4]

I use this code to make cells change but I feel the Case is too chunky.

Does it currently work?
If it works, and the code isnt slow, is it really worth it to try to re-do it differently?
I think to rewrite it would have different complexities of its own, so I am not sure what is to be gained if you already have a working solution.

 

[Vincent88]

Hi Joe4, it is working.

 

[Vincent88]

Can anyone think of better code !

 

[Joe4]

Quite frankly, if you could simplify it down to just a few "hard-and-fast" rules, you may be able to simplify the code a little (possibly).
But you have different situations, especially as it pertains to the second values (as in some cases, it really is second and third values).
So the fact that your entries are not all the same length make it more complicated (i.e. include "ED" and "ED1" but not "ED6").

So to get rid of that one long "CASE" statement will probably involve having to write a lot more lines of code. So I don't know if I would say if that is an improvement (to make your code even longer).

The "CASE" statement also gives you flexibility, in that it is easy to add or remove more options are any time.
If you tried to do it all on logic, and had some options you wanted to add or remove, it could involve rewriting a chunk of code each time.

So, in my opinion, if the code is working and is not too slow, I would probably opt for what you are doing now, instead of trying to create some longer code trying to incorporate logic to check a myriad of different situations, which need to be checked carefully to account for all exceptions.

 

[Peter_SSs]

it is working.

You say that the code is working but it does not actually compile. For one thing, you have a "Case" statement without a "Select Case" statement.
Could you post your actual working code as I would like to know what that full Select Case statement is to consider if there are viable alternatives.

 

[Vincent88]

Hi Peter_SSs,

AgentProposal_Roster0728_0830.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF	AG	AH	AI	AJ	AK	AL
1	Mdate	Attendance	27-Oct	28-Oct	29-Oct	30-Oct	31-Oct	1-Nov	2-Nov	3-Nov	4-Nov	5-Nov	6-Nov	7-Nov	8-Nov	9-Nov	10-Nov	11-Nov	12-Nov	13-Nov	14-Nov	15-Nov	16-Nov	17-Nov	18-Nov	19-Nov	20-Nov	21-Nov	22-Nov	23-Nov	24-Nov	25-Nov	26-Nov	27-Nov	28-Nov	29-Nov	30-Nov	1-Dec
2	Date	Summary	(5)	(4)	(3)	(2)	(1)	1	2	3	4	5	6	7	8	9	10	11	12	13	14	15	16	17	18	19	20	21	22	23	24	25	26	27	28	29	30	31
3	Cat Goo	T:22 L:0 D:0 E:0 N:0
4	Mathew Yiu	T:22 L:0 D:0 E:0 N:0	E	D1
5	Roy Lai	T:22 L:0 D:1 E:0 N:1						N	G
6	Jonathan Lai	T:22 L:0 D:0 E:0 N:0
7	Vitus Lai	T:22 L:0 D:0 E:1 N:1								E	N
8	Vincent Szeto	T:22 L:0 D:0 E:0 N:0
9	Jason Li	T:22 L:0 D:0 E:0 N:0
202111

Cells with Data Validation
Cell	Allow	Criteria
H3:AL9	List	=ShiftcodeNew
A3:A9	List	=HelpAgent

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)

Application.DisplayStatusBar = False
Application.EnableEvents = False
Application.ScreenUpdating = False


Dim C As Range, rng As Range, rng1 As Range
Dim cArray As Variant

Set rng = Range("C3", Range("AL" & Rows.Count).End(xlUp))

With rng.Borders
    .LineStyle = xlContinuous
    .Weight = xlThin
End With

For Each C In rng
           Select Case UCase(C.Value) & UCase(C.Offset(0, 1).Value)
                Case "ED", "ED1", "ED2", "ED3", "ED4", "ED5", "EG", "EK", _
                "ND", "ND1", "ND2", "ND3", "ND4", "ND5", "NE", "NG", "NK"
                    With C.Resize(, 2)
                        .Borders.LineStyle = xlContinuous
                        .Borders.Weight = xlThick
                        .Borders.Color = RGB(102, 0, 255)
                    End With
            End Select
Next C
      

Application.DisplayStatusBar = True
Application.EnableEvents = True
Application.ScreenUpdating = True



End Sub

 

[Peter_SSs]

Thanks for the code and sample data.

I see this is actually a Sub Workbook_SheetCalculate(ByVal Sh As Object) event code yet nowhere in the code does it use the "Sh" object.

Why do you have this in Wokbook_SheetCalculate code and not simply Worksheet_Calculate code for the particular sheet? Do you have multiple sheets in this workbook for which you wish to run this same code?

Assuming that this is to operate on a single sheet, you could, in a copy of your workbook, remove the above code and try this code in the particular worksheet's module, rather than the ThisWorkbook module.

I don't see it as much less 'chunky' or as 'better' code than what you had. Further, I doubt most users would find it as easy to maintain/edit if changes were required. Still, the choice is yours, if this does the job for you.

Private Sub Worksheet_Calculate()
  Application.DisplayStatusBar = False
  Application.EnableEvents = False
  Application.ScreenUpdating = False
  
  Dim C As Range, rng As Range
  Dim RX As Object
  
  Set RX = CreateObject("VBScript.RegExp")
  RX.Pattern = "(^[EN]#((D[1-5]?)|G|K)$)|(^N#E$)"
  
  Set rng = Range("C3", Range("AL" & Rows.Count).End(xlUp))
  With rng.Borders
      .LineStyle = xlContinuous
      .Weight = xlThin
  End With

  For Each C In rng
    If RX.Test(UCase(C.Value) & "#" & UCase(C.Offset(0, 1).Value)) Then
      With C.Resize(, 2).Borders
        .Weight = xlThick
        .Color = RGB(102, 0, 255)
      End With
    End If
  Next C
  
  Application.DisplayStatusBar = True
  Application.EnableEvents = True
  Application.ScreenUpdating = True
End Sub