Highlight/identify last column containing text in each row

[RichCowell]

Hi all,

I'm usually hopeful that things will be possible somehow when I post here, but I'm dubious about this one...

I've got a list of companies in one column, then a column for each meeting they attend, some haven't attended for ages, so I'd like to identify that somehow, like changing the font of format of the cell.

e.g.

[TABLE="class: grid, width: 500, align: center"]
<tbody>[TR]
[TD="align: center"][/TD]
[TD="align: center"]A
[/TD]
[TD="align: center"]B
[/TD]
[TD="align: center"]C
[/TD]
[TD="align: center"]D
[/TD]
[TD="align: center"]E
[/TD]
[/TR]
[TR]
[TD="align: center"]1
[/TD]
[TD]Company
[/TD]
[TD="align: center"]Meet 1
[/TD]
[TD="align: center"]Meet 2
[/TD]
[TD="align: center"]Meet 3
[/TD]
[TD="align: center"]Meet 4
[/TD]
[/TR]
[TR]
[TD="align: center"]2
[/TD]
[TD]BBC
[/TD]
[TD="align: center"][/TD]
[TD="align: center"]X
[/TD]
[TD="align: center"]X
[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]3
[/TD]
[TD]ITV
[/TD]
[TD="align: center"]X
[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]4
[/TD]
[TD]Channel 4
[/TD]
[TD="align: center"]X
[/TD]
[TD="align: center"]X
[/TD]
[TD="align: center"]X
[/TD]
[TD="align: center"]X
[/TD]
[/TR]
</tbody>[/TABLE]

The whole spreadsheet is 42 columns wide so far, and will be growing gradually by at least 15 columns per year, so it's a bit of a pain to keep looking.

Thanks,
Rick

 

[mumps]

Try:

Sub HighlightCol()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim lColumn As Long
    lColumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
    Dim company As Range
    Cells.Interior.ColorIndex = xlNone
    For Each company In Range("A2:A" & LastRow)
        lColumn = ActiveSheet.Cells(company.Row, Columns.Count).End(xlToLeft).Column
        Cells(company.Row, lColumn).Interior.ColorIndex = 3
    Next company
    Application.ScreenUpdating = True
End Sub

 

[RichCowell]

Thanks for that - I've realised I should have mentioned the data is in a table - as I've just run that and it's just highlighted the last column of the table...

Can it still be done with the data in a table?

 

[mumps]

Try:

Sub HighlightCol()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim lColumn As Long
    lColumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
    Dim company As Range
    Cells.Interior.ColorIndex = xlNone
    For Each company In Range("A2:A" & LastRow)
        lColumn = ActiveSheet.Rows(company.Row).Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        Cells(company.Row, lColumn).Interior.ColorIndex = 3
    Next company
    Application.ScreenUpdating = True
End Sub

 

[RichCowell]

That's great! Thank you!

 

[mumps]

You are very welcome.