• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

How to Create Cross Hair for active cell

dassio45

New Member
Hello,

This is my first post on this forum.

I have a large table with data spread across rows and columns. I want to basically create a cross hair when I actively move cells.

I found this VBA code online, it works well but the only problem is that it deletes currently highlighted/colored cells but leaves the Borders as it is when the macro runs on the sheet.
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'UpdatebyRahulDas
    Application.ScreenUpdating = False
    With Target
        .Worksheet.Cells.Interior.ColorIndex = 0
        .EntireRow.Interior.ColorIndex = 24
        .EntireColumn.Interior.ColorIndex = 20
    End With
    Application.ScreenUpdating = True
End Sub

I also have another formula which creates a cross hair using borders rather than highlights but this one deletes the existing borders as you actively move cells BUT leaves the Highlighted/Colored cells in unaffected.

Code:
Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
'Highlight cell
Static xRow
Static xColumn
If xColumn <> "" Then
    With Columns(xColumn).Borders
        .ColorIndex = xlNone
    End With
    With Rows(xRow).Borders
        .ColorIndex = xlNone
    End With
End If
pRow = Selection.Row
pColumn = Selection.Column
xRow = pRow
xColumn = pColumn
With Columns(pColumn).Borders(xlEdgeLeft)
    .ColorIndex = 10
    .Weight = xlThick
End With
With Columns(pColumn).Borders(xlEdgeRight)
    .ColorIndex = 10
    .Weight = xlThick
End With
With Rows(pRow).Borders(xlEdgeTop)
    .ColorIndex = 5
    .Weight = xlThick
End With
With Rows(pRow).Borders(xlEdgeBottom)
    .ColorIndex = 5
    .Weight = xlThick
End With
End Sub

How do I get a solution to either one.

Where I can use a Highlight but it doesn't delete the existing highlighted/colored cells OR

Where I can use a Border but it doesn't delete the existing bordered cells.

MOD EDIT: ADDED CODE TAGS. PLEASE USE CODE TAGS WHILE POSTING CODE.
 
Last edited by a moderator:
Untested ... try these :

Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'UpdatebyRahulDas
Application.ScreenUpdating = False
With Target
.EntireRow.Interior.ColorIndex = 24
.EntireColumn.Interior.ColorIndex = 20
End With
Application.ScreenUpdating = True
End Sub

Code:
Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
'Highlight cell
Static xRow
Static xColumn

pRow = Selection.Row
pColumn = Selection.Column
xRow = pRow
xColumn = pColumn
With Columns(pColumn).Borders(xlEdgeLeft)
.ColorIndex = 10
.Weight = xlThick
End With
With Columns(pColumn).Borders(xlEdgeRight)
.ColorIndex = 10
.Weight = xlThick
End With
With Rows(pRow).Borders(xlEdgeTop)
.ColorIndex = 5
.Weight = xlThick
End With
With Rows(pRow).Borders(xlEdgeBottom)
.ColorIndex = 5
.Weight = xlThick
End With
End Sub
 
Thank you for the reply, I tested your code but its doing the complete opposite of what I want.

Check the excel file I have attached and read the notes in the sheets.

Thanks!
 

Attachments

  • TRIAL.xlsm
    24.6 KB · Views: 10
This is what I found online...

It's a Rick Rothstein response to a somewhat similiar question a couple years ago.
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Application.ScreenUpdating = False
  Application.FindFormat.Clear
  Application.ReplaceFormat.Clear
  Application.FindFormat.Interior.Color = 65534 'one less than vbYellow's value
  Application.ReplaceFormat.Interior.Color = xlNone
  Cells.Replace "", "", SearchFormat:=True, ReplaceFormat:=True
  Application.FindFormat.Clear
  Application.ReplaceFormat.Clear
  Application.FindFormat.Interior.Color = xlNone
  Application.ReplaceFormat.Interior.Color = 65534 'one less than vbYellow's value
  Target.EntireRow.Replace "", "", SearchFormat:=True, ReplaceFormat:=True
  Target.EntireColumn.Replace "", "", SearchFormat:=True, ReplaceFormat:=True
  Application.FindFormat.Clear
  Application.ReplaceFormat.Clear
  Application.ScreenUpdating = True
End Sub
 
In the attached, 2 sheets, different methods; one uses a selection technique to highlight cells, the other draws lines on the sheet. Either way, no formatting is changed.
The one which uses selection to highlight goes like this (it also makes it hard to copy/move stuff around!!):
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
Union(Target.EntireRow, Target.EntireColumn).Select
Intersect(Target.EntireRow, Target.EntireColumn).Activate
Application.EnableEvents = True
End Sub
The other's a bit longer.
 

Attachments

  • highlight activecell row and column.xlsm
    22.4 KB · Views: 21
@NoSparks

But did you notice when you use this code your UNDO and REDO features have been disabled. I mean the VBA erases the UNDO and REDO features.
 
@p45cal

Thanks, I like the sheet 1 but then this VBA code disables the UNDO feature. What I mean is go and enter a value in a cell and press Enter. You will not be able to undo or redo.

Sheet 2, is great too but the crosshair doesnt move as you keep entering values into a different cell. E.g. take cell a1.. enter a value, press enter, cell a 2 enter value.. press enter... you will notice the cross hair is at cell a1 .. unless you click cell a3 it wont refresh. this doesnt happen in sheet one. if you can fix sheet 1 with the undo and redo.. then that will be awesome...
 
Thanks, I like the sheet 1 but then this VBA code disables the UNDO feature. What I mean is go and enter a value in a cell and press Enter. You will not be able to undo or redo.
Here in Excel 2010 I was allowed to undo/redo.




Sheet 2, is great too but the crosshair doesnt move as you keep entering values into a different cell. E.g. take cell a1.. enter a value, press enter, cell a 2 enter value.. press enter... you will notice the cross hair is at cell a1 .. unless you click cell a3 it wont refresh. this doesnt happen in sheet one. if you can fix sheet 1 with the undo and redo.. then that will be awesome...
This is not my experience. Do you have other code running?
 
Then it's a 2016 thing unless there's any sheet event handlers operating in the ThisWorkbook code-module.
 
double-click on the ThisWorkbook module in the left pane (Ctrl+r if it's not showing) in the VBE. Ids there any code there?
To find out what event handlers there are (sheet or otherwise), in the left hand dropdown at the top of the main code pane in the VBE, choose Workbook, then in the right and dropdown you'll see a list of event handlers.
 
@NoSparks

But did you notice when you use this code your UNDO and REDO features have been disabled. I mean the VBA erases the UNDO and REDO features.

Not only noticed, but expected. I believe running any macro that does anything to a sheet automatically clears the UNDO stack.

I'll keep watching this thread in hopes of finding out why (or how) in post #8 p45cal indicates he was allowed to undo/redo.

 
double-click on the ThisWorkbook module in the left pane (Ctrl+r if it's not showing) in the VBE. Ids there any code there?
To find out what event handlers there are (sheet or otherwise), in the left hand dropdown at the top of the main code pane in the VBE, choose Workbook, then in the right and dropdown you'll see a list of event handlers.

I checked the "workbook" module and I did not find any code in it. I could not find when you said "then in the right and dropdown youll see a list of even handlers."
 
I checked the "workbook" module and I did not find any code in it. I could not find when you said "then in the right and dropdown youll see a list of even handlers."
upload_2017-11-27_11-5-47.png
 

Attachments

  • upload_2017-11-27_11-3-54.png
    upload_2017-11-27_11-3-54.png
    31 KB · Views: 4
Hi Dassio,

I took this one from a book once,
Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'highlight active row and column
'declare variable
Dim strrange As String
'build the range string
strrange = Target.Cells.Address & "," & _
Target.Cells.EntireColumn.Address & "," & _
Target.Cells.EntireRow.Address
'pass range string to range
Range(strrange).Select
End Sub

The way this was intended you create a worksheet, open up vba, select the Worksheet, "beforeDoubleClick" option and then insert this code, your rows and columns get selected creating a crosshair as you double click on a cell.

I think you could modify this to work with the SelectionChange, if at the start you added an argument to stop if more than 1 cells are selected.
 

Attachments

  • Crosshair in vba.xlsm
    12.9 KB · Views: 9
Last edited:
Here, this one works with selection change

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Cells.Count = 1 Then
'highlight active row and column
'declare variable
Dim strrange As String
'build the range string
strrange = Target.Cells.Address & "," & _
Target.Cells.EntireColumn.Address & "," & _
Target.Cells.EntireRow.Address
'pass range string to range
Range(strrange).Select
End If
End Sub
 

Attachments

  • Crosshair in vba2.xlsm
    13.1 KB · Views: 12
Back
Top