asked on

How to select Multiple cells and highlight

Hi ,
I want to select multiple cells and Highlight the column in which the cells are located.

Dim LastColumn As Long
LastColumn = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column
Dim LastRow
LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
If (Selection.Column >= 1 And Selection.Column <= LastColumn) And (Selection.Row >= 6 And Selection.Row <= LastRow) Then
Application.ScreenUpdating = False
With Selection
If (Selection.Column >= 1 And Selection.Column <= 2) And (Selection.Row >= 6 And Selection.Row <= LastRow) Then
MsgBox ("Cannot Mark This Area")
Else
Dim a
Set a = Range(Cells(6, Selection.Column), Cells(LastRow, Selection.Column))
a.Interior.Color = RGB(255, 255, 0)
End If
End With
Application.ScreenUpdating = True
Else
MsgBox ("Cant Mark This Area")
End If

the problem in this code is I can highlight multiple columns
Can you please modify the code that I have.
Thank you

ASKER CERTIFIED SOLUTION

Rgonzo1971

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Roy Cox

Try this

Option Explicit

Dim LastColumn As Long
LastColumn = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column
Dim LastRow
LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
If Selection.Columns.Count > 1 Then
    MsgBox "Please select only cells in one column,", vbCritical, "Quitting"
    Exit Sub
End If

If (Selection.Column >= 1 And Selection.Column <= LastColumn) And (Selection.Row >= 6 And Selection.Row <= LastRow) Then
    Application.ScreenUpdating = False
    With Selection
        If (Selection.Column >= 1 And Selection.Column <= 2) And (Selection.Row >= 6 And Selection.Row <= LastRow) Then
            MsgBox ("Cannot Mark This Area")
        Else
            Dim a
            Set a = Range(Cells(6, Selection.Column), Cells(LastRow, Selection.Column))
            a.Interior.Color = RGB(255, 255, 0)
        End If
    End With
    Application.ScreenUpdating = True
Else
    MsgBox ("Cant Mark This Area")
End If

Open in new window

NewBieSteffie

ASKER

Thank you for answering my questions it is very much appreciated.