Make Column appearance change

[Vincent88]

Hi Guys, I want the make change of the columns in a dynamic range from col H to AL.
In each column, find if these text - "E", "G" and "N" appears only one, if conditions meet, trigger the change of that column
I don't think I am using the correct dim and reference !
Please help.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Select Case Sh.Name
    Case "Data"
      Exit Sub
    Case Else
  End Select

'Highlight Column in Range
If Not Intersect(Target, Range("H3:AL" & lastRow)) Is Nothing Then
If Not IsNumeric(Target.Value) Then

Dim gVal As String, eVal As Integer, nVal As Integer
Dim rng As Range, colrng As Range
Dim lastRow As Long

lastRow = Range("A3").End(xlDown).Row

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


eVal = Application.WorksheetFunction.Range(Range(Columns.Count & Rows.Count).End(xlUp), "E") = 1
gVal = Application.WorksheetFunction.Range(Range(Columns.Count & Rows.Count).End(xlUp), "G") = 1
nVal = Application.WorksheetFunction.Range(Range(Columns.Count & Rows.Count).End(xlUp), "N") = 1


'eVal = Application.WorksheetFunction.CountIf(Range("H3:H14"), "E") = 1
'gVal = Application.WorksheetFunction.CountIf(Range("H3:H14"), "G") = 1
'nVal = Application.WorksheetFunction.CountIf(Range("H3:H14"), "N") = 1


 If eVal = True And gVal = True And nVal = True Then Exit Sub
      'No Change if criteria met
           With rng.Borders
                .LineStyle = xlContinuous
                .Weight = xlThin
           End With
 
 If eVal = True And gVal = True Then
      'Only these criteria met
      cell(1, Columns.Count).Font.FontStyle = "Bold Italic"
 Else
      'Any combinations of eVal, gVal and nVal triggers the change
        
  Set colrng = Range(Columns.Count & Rows.Count).End(xlUp)
           With colrng.Borders
                .LineStyle = xlContinuous
                .Weight = xlThick
                .Color = vbBlue
           End With

End Sub

 

[Alex Blakenburg]

I am not clear on what the conditions are that you are trying to meet.
Do you mean E only appears once across all column from H to AL ? or do you mean once in each column ?

Your initial countifs version now commented out looks more correct.
I would make all these boolean
Dim gVal As Boolean, eVal As Boolean, nVal As Boolean

 

[Vincent88]

Hi, the value E , G and N can only enter once in each column within the range. If all of them are entered, then exit sub. So I need to count them.

 

[Alex Blakenburg]

It sounds like you want to loop through each column and check if E, G, N appear in the column and that they only appear once.
I do not really understand what you are trying to do with it, exiting after you have tested the first column and it doesn't meet the conditions seems an unlikely requirement.

Here is some code that would do the loop. It is currently outputting to the immediate window.
Be careful with this through since H to AL is 31 columns.
Your existing code seems to set the lastrow once on column A and once on column AL, I have just used column A in the below.

Sub loopColumns()

    Dim rng As Range
    Dim lastRow As Long
    Dim rngCol As Range
    Dim gVal As Boolean, eVal As Boolean, nVal As Boolean
    
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    Set rng = Range("H3", Range("AL" & lastRow))
    
    For Each rngCol In rng.Columns

        eVal = Application.WorksheetFunction.CountIf(rngCol, "E") = 1
        gVal = Application.WorksheetFunction.CountIf(rngCol, "G") = 1
        nVal = Application.WorksheetFunction.CountIf(rngCol, "N") = 1
        

        Debug.Print rngCol.Address, eVal, gVal, nVal
    Next rngCol
    
End Sub

 

[Vincent88]

Hi Alex Blakenburg,
This code shows no error and I see the column address with True and False status but how to proceed further if I want for each column
1. exit sub if all three are true
2. if eval and gval exist then the cell 1 of that column (H1, AA1, AL1 etc.,) be highlighted in green else its turns yellow

Please evaluate and help further. Thanks

 

[Alex Blakenburg]

I can't understand the Exit Sub.
On the one hand you seem to want each column tested but then you say you want to exit the sub when the conditions aren't met and that could happen in the first column.

Also please clarify what you want to happen if:-

• eval gval & nval are all true
  At the moment it will apply borders if any one of them is false.
  It will do nothing if they are all true (and stop processing because of the exit sub)
  
  
• if eval & gval are true
  If your applying of borders is back to front and you want to apply borders when all three are true.
  If the applying of Italics in Addition to this.
  
  
• What combination are you expecting the else part to apply to ?
  

 

[Vincent88]

Hi Alex Blakenburg, With you help, I continue rest of the code and get my mission accomplished. I thought the code should be complicated at the beginning but your valueable advice make my life much easier. Many Many thanks.

Option Explicit

Sub loopColumns()

    Dim rng As Range
    Dim lastrow As Long
    Dim rngCol As Range
    Dim gVal As Boolean, eVal As Boolean, nVal As Boolean
    
    lastrow = Cells(Rows.Count, "A").End(xlUp).Row
      
    Set rng = Range("H1", Range("AL" & lastrow))
    
                 With rng
                     .Font.Italic = False
                     .Font.Bold = False
                     .Font.Color = vbBlack
                 End With
    
    For Each rngCol In rng.Columns
        eVal = Application.WorksheetFunction.CountIf(rngCol, "E") = 1
        gVal = Application.WorksheetFunction.CountIf(rngCol, "G") = 1
        nVal = Application.WorksheetFunction.CountIf(rngCol, "N") = 1
        
       Debug.Print rngCol.Address, eVal, gVal, nVal
        If (eVal = True And gVal = True And nVal = True) Then
                 With rngCol
                     .Font.Italic = False
                     .Font.Bold = False
                 End With
                 rngCol.Cells(1).Font.Italic = False
                
        ElseIf (eVal = True And gVal = True And nVal = False) Then
                   rngCol.Cells(1).Font.Italic = True
    
        Else
                With rngCol
                   .Font.Italic = True
                   .Font.Bold = True
                End With
       End If
     Next rngCol
    
 End Sub

 

[Alex Blakenburg]

I appreciate your feedback and for showing us your modified code. Glad I was able to help.

 

[Vincent88]

I appreciate your feedback and for showing us your modified code. Glad I was able to help.

Hi Alex Blakenburg,
Is it possible to make the code as array in order to have it runs faster !

 

[Alex Blakenburg]

We are summing a whole column not individual cells. So it is unlikely that using an array will make is any faster.
You are formatting whole columns as well, so limiting this to just the used rows would probably speed it up some.

Try adding this to the beginning and end of your code.

Beginning

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

End

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