1. Welcome to Chandoo.org Forums. Short message for you

    Hi Guest,

    Thanks for joining Chandoo.org forums. We are here to make you awesome in Excel. Before you post your first question, please read this short introduction guide. When posting or responding to questions please remember our values at Chandoo.org are: Humility, Passion, Fun, Awesomeness, Simplicity, Sharing Remember that we have people here for whom English is not there first language and we need to allow for this in our dealings.

    Yours,
    Chandoo
  2. 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...

  3. 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

Discussion in 'VBA Macros' started by dassio45, Nov 20, 2017.

  1. dassio45

    dassio45 New Member

    Messages:
    7
    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 (vb):

    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 (vb):

    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: Nov 22, 2017
  2. Logit

    Logit Active Member

    Messages:
    141
    Untested ... try these :

    Code (vb):

    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 (vb):

    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
     
  3. dassio45

    dassio45 New Member

    Messages:
    7
    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!

    Attached Files:

  4. NoSparks

    NoSparks New Member

    Messages:
    14
    This is what I found online...

    It's a Rick Rothstein response to a somewhat similiar question a couple years ago.
    Code (vb):

    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
     
    NARAYANK991 likes this.
  5. p45cal

    p45cal Well-Known Member

    Messages:
    977
    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 (vb):
    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.

    Attached Files:

  6. dassio45

    dassio45 New Member

    Messages:
    7
    @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.
  7. dassio45

    dassio45 New Member

    Messages:
    7
    @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...
  8. p45cal

    p45cal Well-Known Member

    Messages:
    977
    Here in Excel 2010 I was allowed to undo/redo.




    This is not my experience. Do you have other code running?
  9. dassio45

    dassio45 New Member

    Messages:
    7

    Nope, instead i pasted your code in a new sheet and same thing. I am using 2016 office.
  10. p45cal

    p45cal Well-Known Member

    Messages:
    977
    Then it's a 2016 thing unless there's any sheet event handlers operating in the ThisWorkbook code-module.
  11. dassio45

    dassio45 New Member

    Messages:
    7
    how do i find out sheet event handlers?
  12. p45cal

    p45cal Well-Known Member

    Messages:
    977
    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.
  13. NoSparks

    NoSparks New Member

    Messages:
    14
    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.

  14. dassio45

    dassio45 New Member

    Messages:
    7
    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."
  15. Kenneth Hobson

    Kenneth Hobson Active Member

    Messages:
    190
    ThisWorkbook object, not a Module.

    Another way to get into ThisWorkbook object is to right click a tab, View Code.
  16. p45cal

    p45cal Well-Known Member

    Messages:
    977
    upload_2017-11-27_11-5-47.png

    Attached Files:

  17. Nightlytic

    Nightlytic Member

    Messages:
    88
    Hi Dassio,

    I took this one from a book once,
    Code (vb):
    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.

    Attached Files:

    Last edited: Nov 27, 2017
  18. Nightlytic

    Nightlytic Member

    Messages:
    88
    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

    Attached Files:

Share This Page