Select Change code that highlights only the dynamic row

[Oberon70]

I have the below code, which does two things.

1. it highlights the selected row, which helps keep track of manual receipting.
2. This enters the date when selecting an empty cell under the Date Column. The code will work on different reports as the column could be in a different location on other reports. (This works).

However, is it was possible to highlight only the table? And can I make this dynamic?

The other slight headache, but I will live with it unless someone knows a solution. If I fill in a cell with a colour, it is set back to no fill when I click on the spreadsheet due to the highlighting code.

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)



Dim PortfolioCode As Variant

Dim ws As Worksheet

Dim LRow As Integer



Application.ScreenUpdating = False



Set ws = ThisWorkbook.Sheets(2)



PortfolioCode = ws.Range("B1").Value

LRow = Cells(Rows.Count, 1).End(xlUp).Row



Debug.Print ws.Name



Cells.Interior.ColorIndex = xlNone

With Cells(ActiveCell.Row, 1).Resize(1, 20).Interior

.ColorIndex = 24

.Pattern = xlSolid

End With



Select Case PortfolioCode

Case "BATINC", "BATINCT2", "BATINCRC", "BATINC", "ROBINIAE", "ROBINMV2", "ROBINRC", "ROBINT2", "ROBINXSE", "ROBINE", "ROBINUE", "ROBINAH"

If Not Application.Intersect(Target, Range("F1:F" & LRow)) Is Nothing Then

Application.EnableEvents = False

Target.Value = Date

Application.EnableEvents = True

End If

Case "ROBINIAG", "ROBINMVG2", "ROBINRCG", "ROBINXSE", "ROBING", "ROBINUG"

If Target.Column = 4 Then

Application.EnableEvents = False

Target.Value = Date

Application.EnableEvents = True

End If

If Target.Column = 6 Then

Application.EnableEvents = False

Target.Value = Date

Application.EnableEvents = True

End If

Case "ROBINIA", "ROBINMVA2", "ROBINXSA", "ROBINA", "ROBINUA"

MsgBox Anubis

Case Else

'MsgBox "Invalid code"

End Select

Application.ScreenUpdating = True



End Sub

 

[Alex Blakenburg]

You can try something like this but I have found it doesn't work if you click on a cell which is surrounded by blank cells.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Cells.Interior.ColorIndex = xlNone

    With Intersect(ActiveCell.EntireRow, ActiveCell.CurrentRegion).Interior
        .ColorIndex = 24
        .Pattern = xlSolid
    End With

End Sub

 

[JoeMo]

You can try something like this but I have found it doesn't work if you click on a cell which is surrounded by blank cells.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Cells.Interior.ColorIndex = xlNone

    With Intersect(ActiveCell.EntireRow, ActiveCell.CurrentRegion).Interior
        .ColorIndex = 24
        .Pattern = xlSolid
    End With

End Sub

This fixes the cell surrounded by blank cells problem. Don't know whether it covers the OP's requirements:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Cells.Interior.ColorIndex = xlNone
    If Intersect(ActiveCell.EntireRow, ActiveSheet.UsedRange) Is Nothing Then
        With Range(Cells(Target.Row, "A"), Target).Interior
            .ColorIndex = 24
            .Pattern = xlSolid
        End With
    Else
        With Intersect(ActiveCell.EntireRow, ActiveSheet.UsedRange).Interior
            .ColorIndex = 24
            .Pattern = xlSolid
        End With
    End If
End Sub

 

[Oberon70]

thanks for the help. I will try out the above and see how it works. I had to remove the Date being entered automatically, as it had a major headache. It worked great when I enter the designated cell, but it caused the row to be over written when I would select a whole row.

 

[Alex Blakenburg]

I had to remove the Date being entered automatically, as it had a major headache. It worked great when I enter the designated cell, but it caused the row to be over written when I would select a whole row.

If Columns 4 and 6 are the date columns then this might work for those two:

Cells(Target.Row,Target.Column) = Date

For the 1 that is intersect with F you can use either of these

Cells(Target.Row,6) = Date
'OR
Cells(Target.Row,"F") = Date

I don't know if you want to add a check to only do that if that field is blank / empty in case there is already a date there.
eg If Cells(Target.Row,6) = "" Then

 

[Oberon70]

Thank you, that fixed the problem with the Date