I have a spreadsheet in Excel. I have written VBA code that when I select a cell it highlights the entire row and column.
I need the following added:
When a cell is selected it increases the font to 14, it bold the entire row only. In column "A" I need it to auto sort place all cells with the word EMPTY at the top of the sheet, font should be changed to bold red.
This shouldn't be difficult to a VBA guru, I do not have this talent.
Private Sub Workbook_Open()
Call FormatDatesBasedOnRange
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim monitorRange As Range
Set monitorRange = Me.Range("$I$2:$N$59")
If Not Intersect(Target, monitorRange) Is Nothing Then
Call FormatDatesBasedOnRange
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.Interior.ColorIndex = xlNone
Cells.Font.Size = 11
With Target
.EntireRow.Interior.Color = RGB(255, 255, 153)
.EntireColumn.Interior.Color = RGB(255, 255, 153)
.Font.Size = 11
End With
End Sub
Private Sub Worksheet_Activate()
Call FormatDatesBasedOnRange
End Sub
Sub FormatDatesBasedOnRange()
On Error GoTo ErrorHandler
Dim ws As Worksheet
Dim dateRange As Range
Dim cell As Range
Dim currentDate As Date
Dim dateDiff As Long
Set ws = ThisWorkbook.Sheets("Drivers Final")
Set dateRange = ws.Range("$H$2:$M$59")
currentDate = Date
Application.ScreenUpdating = False
For Each cell In dateRange
If IsDate(cell.Value) Then
dateDiff = cell.Value - currentDate
Select Case dateDiff
Case 0 To 30
cell.Font.Bold = True
cell.Font.Color = RGB(255, 0, 0)
Case 31 To 60
cell.Font.Bold = True
cell.Font.Color = RGB(0, 0, 255)
Case Else
cell.Font.Bold = False
cell.Font.ColorIndex = xlAutomatic
End Select
Else
cell.Font.Bold = False
cell.Font.ColorIndex = xlAutomatic
End If
Next cell
Application.ScreenUpdating = True
Exit Sub
ErrorHandler:
Application.ScreenUpdating = True
MsgBox "An error occurred: " & Err.Description, vbCritical, "Error"
End Sub