change colour based on wildcard?

Trevor3007 · Jun 10, 2019

evening,

i have the code below (it runs within more code, I just extracted & added the 'end sub')

Works great in the workbook that it was originally designed for.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
 
Application.ScreenUpdating = False
    Dim rng As Range
      
    For Each rng In Range("h3:h8000")
        Select Case rng.Value
            Case "Build Completed"
                With Range("A" & rng.Row).Resize(1, 22)
                    .Interior.ColorIndex = 4
                    .Font.Bold = True
                End With
            Case "Swapped-Out"
                With Range("A" & rng.Row).Resize(1, 22)
                    .Interior.ColorIndex = 22
                    .Font.Bold = True
                End With
            Case "Build Started"
                With Range("A" & rng.Row).Resize(1, 22)
                    .Interior.ColorIndex = 6
                    .Font.Bold = True
                End With
            Case "Device Not Received"
                With Range("A" & rng.Row).Resize(1, 22)
                    .Interior.ColorIndex = 28
                    .Font.Bold = True
                End With
            Case "Emailed Requested For SCCM Check"
                With Range("A" & rng.Row).Resize(1, 22)
                    .Interior.ColorIndex = 38
                    .Font.Bold = True
                End With
            Case "Desktop UAD - On Hold ATM"
                With Range("A" & rng.Row).Resize(1, 22)
                    .Interior.ColorIndex = 44
                    .Font.Bold = True
                End With
            Case "Device With Build Engineer"
                With Range("A" & rng.Row).Resize(1, 22)
                    .Interior.ColorIndex = 40
                    .Font.Bold = False
                End With
            Case ""
                With Range("A" & rng.Row).Resize(1, 22)
                    .Interior.ColorIndex = xlNone
                    .Font.Bold = False
                End With
        End Select
    Next rng
    Application.ScreenUpdating = True
    End sub

however, I would wish to use it in another workbook,

Code:

 [COLOR=#ff0000]For Each rng In Range("h3:h8000")
        Select Case rng.Value
            Case "3rd floor engineer door - locked"[/COLOR]

The red text above , is it possible to use a wildcard IE *locked' and it will trigger the colour change?
I tried , but no luck. Hoping someone has the knowledge?

Fingers crossed .

Trevor3007 · Jun 12, 2019

DANTE!!!!

used your original & it works great ( had to change words as the USER requested). anyhoo , yes FANTASTIC. Once you again you have sorted.

DanteAmor · Jun 12, 2019

Trevor3007 said:
DANTE!!!!

used your original & it works great ( had to change words as the USER requested). anyhoo , yes FANTASTIC. Once you again you have sorted.

I'm glad to help you. Thanks for the feedback.

Trevor3007 · Jun 13, 2019

hi,

thought all was going good ?? but ran your code:-

Code:

Private Sub Worksheet_Change(ByVal Target As Range)    
    '''''
    Dim sh As Worksheet, cases As Variant, colors As Variant, i As Long
    Application.ScreenUpdating = False
    Set sh = ActiveSheet
    cases = Array("Build Completed", "Swapped-Out", "Build Started", "Device Not Received", _
                  "Emailed Requested For SCCM Check", "test", _
                  "*Engineer*", "*locked*", "")
    
    colrs = Array(4, 22, 6, 28, 38, 44, 40, 5, xlNone)
    For i = 0 To UBound(cases)
[SIZE=6]        sh.Range("A2:H8000").AutoFilter 8, cases(i)[/SIZE]
        sh.AutoFilter.Range.Offset(1).Interior.ColorIndex = colrs(i)
        sh.AutoFilter.Range.Offset(1).Font.Bold = True
    Next
    sh.ShowAllData
    '''''
    
End Sub

the enlarged text is above ,( highlighted in yellow via the debugger) seems to be the issue?

DanteAmor · Jun 13, 2019

Trevor3007 said:
hi,

thought all was going good ?? but ran your code:-

the enlarged text is above ,( highlighted in yellow via the debugger) seems to be the issue?

What does the error message say?

Do any of the cases not exist on the sheet?

Trevor3007 · Jun 13, 2019

hi there,

What does the error message say?

Autofilter method of range class failed



Do any of the cases not exist on the sheet?

NO :{

I
I even tested on a totally 'blank' workbook & same error :{

Trevor3007 · Jun 13, 2019

hi there,

What does the error message say?

Autofilter method of range class failed



Do any of the cases not exist on the sheet?

I checked tested each word & no reaction.

I even tested on a totally 'blank' workbook & same error :{

DanteAmor · Jun 13, 2019

Trevor3007 said:
hi there,

What does the error message say?
Autofilter method of range class failed
Do any of the cases not exist on the sheet?
I checked tested each word & no reaction.
I even tested on a totally 'blank' workbook & same error :{

Do you have something else in the code?
You have to limit the modification range in the cells.
If you modify many cells at once, or delete a column or delete a row, the macro will collapse.

Try this

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sh As Worksheet, cases As Variant, colors As Variant, i As Long
    Application.ScreenUpdating = False
    If Not Intersect(Target, Range("H:H")) Is Nothing Then
        If Target.Count > 1 Then Exit Sub
        Set sh = ActiveSheet
        If sh.AutoFilterMode Then sh.AutoFilterMode = False
        cases = Array("Build Completed", "Swapped-Out", "Build Started", "Device Not Received", _
                      "Emailed Requested For SCCM Check", "Desktop UAD - On Hold ATM", _
                      "*Engineer*", "*locked*", "")
        
        colrs = Array(4, 22, 6, 28, 38, 44, 40, 5, xlNone)
        For i = 0 To UBound(cases)
            sh.Range("A2:H8000").AutoFilter 8, cases(i)
            sh.AutoFilter.Range.Offset(1).Interior.ColorIndex = colrs(i)
            sh.AutoFilter.Range.Offset(1).Font.Bold = True
        Next
        sh.ShowAllData
    End If
End Sub

Trevor3007 · Jun 16, 2019

hi,

found the prob ..but cannot resolve!!!! seems to be the 'works' laptop???? it wil either completly fill the page with a colour pending word, IE locked) ... or it wont use any clolour ??? Howver If I use it on my pers laptop it works a treat!!! go figure ????

Thanks you anyhoo DA.. I wil have to just stick with what i have :{ unless I can sweet chat them to give me another laptop?

DanteAmor · Jun 17, 2019

Trevor3007 said:
hi,

found the prob ..but cannot resolve!!!! seems to be the 'works' laptop???? it wil either completly fill the page with a colour pending word, IE locked) ... or it wont use any clolour ??? Howver If I use it on my pers laptop it works a treat!!! go figure ????

Thanks you anyhoo DA.. I wil have to just stick with what i have :{ unless I can sweet chat them to give me another laptop?

Try

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sh As Worksheet, cases As Variant, colors As Variant, i As Long, lr as long
    Application.ScreenUpdating = False
    If Not Intersect(Target, Range("H:H")) Is Nothing Then
        If Target.Count > 1 Then Exit Sub
        Set sh = ActiveSheet
        If sh.AutoFilterMode Then sh.AutoFilterMode = False
        cases = Array("Build Completed", "Swapped-Out", "Build Started", "Device Not Received", _
                      "Emailed Requested For SCCM Check", "Desktop UAD - On Hold ATM", _
                      "*Engineer*", "*locked*", "")
        
        colrs = Array(4, 22, 6, 28, 38, 44, 40, 5, xlNone)
        lr = sh.range("H" & rows.count).end(xlup).row
        For i = 0 To UBound(cases)
            sh.Range("A2:H" & lr).AutoFilter 8, cases(i)
            sh.AutoFilter.Range.Offset(1).Interior.ColorIndex = colrs(i)
            sh.AutoFilter.Range.Offset(1).Font.Bold = True
        Next
        sh.ShowAllData
    End If
End Sub

Trevor3007 · Jun 17, 2019

DanteAmor said:

Try

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sh As Worksheet, cases As Variant, colors As Variant, i As Long, lr as long
    Application.ScreenUpdating = False
    If Not Intersect(Target, Range("H:H")) Is Nothing Then
        If Target.Count > 1 Then Exit Sub
        Set sh = ActiveSheet
        If sh.AutoFilterMode Then sh.AutoFilterMode = False
        cases = Array("Build Completed", "Swapped-Out", "Build Started", "Device Not Received", _
                      "Emailed Requested For SCCM Check", "Desktop UAD - On Hold ATM", _
                      "*Engineer*", "*locked*", "")
        
        colrs = Array(4, 22, 6, 28, 38, 44, 40, 5, xlNone)
        lr = sh.range("H" & rows.count).end(xlup).row
        For i = 0 To UBound(cases)
            sh.Range("A2:H" & lr).AutoFilter 8, cases(i)
            sh.AutoFilter.Range.Offset(1).Interior.ColorIndex = colrs(i)
            sh.AutoFilter.Range.Offset(1).Font.Bold = True
        Next
        sh.ShowAllData
    End If
End Sub

thank you once again Dante Amor,

again NO colour, but 'bolds' the entire column????

it must be the laptop I am using as it works fine on my personal laptop.

I will get back to you OK?

change colour based on wildcard?

Trevor3007

Well-known Member

Trevor3007

Well-known Member

Excel Facts

DanteAmor

Well-known Member

Trevor3007

Well-known Member

DanteAmor

Well-known Member

Trevor3007

Well-known Member

Trevor3007

Well-known Member

DanteAmor

Well-known Member

Trevor3007

Well-known Member

DanteAmor

Well-known Member

Trevor3007

Well-known Member

Similar threads

Forum statistics

Share this page

change colour based on wildcard?

Well-known Member

Well-known Member

Excel Facts

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock