Highlighting row where you are

[Bethiepooh]

I am interested in finding out how I can highlight the row I am currently working in? When I move rows, I want the highlighting to move to the appropriate row. How do you do this?

 

[aldo]

Thanks maxflia10.

But I want to have rows highlighted by just selecting the row and the recalc routine suggested in the link which facilitates this clears the clipboard so that I cannot paste.

What would work is an if...then statement which avoided the subroutine if I was in copy mode. Is it possible?
This message was edited by aldo on 2003-01-22 19:04

 

[NateO]

Howdy aldo, yes indeed. You'll need to manually clear your clip board (hit esc) or create a bunch of trapping to reinstate the program:<pre>
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim iColor As Integer
'/// Further Amended routine from IFM found on this Web site
'// Note: Don't use IF you have Conditional
'// formating that you want to keep!

'// On error resume in case
'// user selects a range of cells
If Application.CutCopyMode Then Exit Sub

On Error Resume Next
iColor = Target.Interior.ColorIndex
'Leave On Error ON for Row offset errors

If iColor< 0 Then
iColor = 36
Else
iColor = iColor + 1
End If

'// Need this test incase Font color is the same
If iColor = Target.Font.ColorIndex Then iColor = iColor + 1

Cells.FormatConditions.Delete

'// Horizontal color banding
With Range("A" & Target.Row, Target.Address) 'Rows(Target.Row)
.FormatConditions.Add Type:=2, Formula1:="TRUE"
.FormatConditions(1).Interior.ColorIndex = iColor
End With

End Sub</pre>


Edit: Another way to copy & paste is to use the non-b$st#rd@z*d version and utilize the Windows clipboard:<pre>
Public Declare Function GlobalAlloc32 Lib "kernel32" Alias "GlobalAlloc" _
(ByVal wFlags As Long, ByVal dwBytes As Long) As Long

Public Declare Function GlobalLock32 Lib "kernel32" Alias "GlobalLock" _
(ByVal hMem As Long) As Long

Public Declare Function OpenClipboard32 Lib "User32" Alias "OpenClipboard" _
(ByVal hwnd As Long) As Long

Public Declare Function GlobalUnlock32 Lib "kernel32" Alias "GlobalUnlock" _
(ByVal hMem As Long) As Long

Public Declare Function lstrcpy32 Lib "kernel32" Alias "lstrcpy" _
(ByVal lpString1 As Any, ByVal lpString2 As Any) As Long

Public Declare Function CloseClipboard32 Lib "User32" Alias "CloseClipboard" _
() As Long

Public Declare Function SetClipBoardData32 Lib "User32" _
Alias "SetClipboardData" (ByVal wFormat As Long, ByVal hMem As Long) As Long

Declare Function GetClipboardData32 Lib "User32" Alias "GetClipboardData" _
(ByVal wFormat As Long) As Long

Declare Function EmptyClipboard32 Lib "User32" Alias "EmptyClipboard" () As Long

Global Const CF_TEXT = 1

Sub CB_SendData()
Dim StrBuf As String
Dim CurrRow As Range, CurrCell As Range
'Build a long string of cell contents (formulas)
' Tabs separate columns
' Carriage returns separate rows
For Each CurrRow In Selection.Rows
For Each CurrCell In CurrRow.Cells
StrBuf = StrBuf & CurrCell.Formula & Chr(9)
Next
'Remove last Tab on row and add carriage return
StrBuf = Left(StrBuf, Len(StrBuf) - 1) & Chr(13)
Next
ClipBoard_SetData32 StrBuf
End Sub

Sub ClipBoard_SetData32(MyString As String)
Dim hGlobalMemory As Long, lpGlobalMemory As Long
Dim hClipMemory As Long
' Allocate moveable global memory.
hGlobalMemory = GlobalAlloc32(&H42, Len(MyString) + 1)
' Lock the block to get a far pointer to this memory.
lpGlobalMemory = GlobalLock32(hGlobalMemory)
' Copy the string to this global memory.
lpGlobalMemory = lstrcpy32(lpGlobalMemory, MyString)
' Unlock the memory.
If GlobalUnlock32(hGlobalMemory)<> 0 Then
MsgBox "Could not unlock memory location. Copy aborted."
GoTo OutOfHere
End If
' Open the Clipboard to copy data to.
If OpenClipboard32(0&) = 0 Then
MsgBox "Could not open the Clipboard. Copy aborted."
Exit Sub
End If
EmptyClipboard32 'Don't know if I really need this
' Copy the data to the Clipboard.
hClipMemory = SetClipBoardData32(CF_TEXT, hGlobalMemory)
OutOfHere:
If CloseClipboard32() = 0 Then
MsgBox "Could not close Clipboard."
End If
End Sub</pre>

You could assign the procedure CB_SendData a shortcut-key to copy, pasting works as expected unless your range size does not line up.... I believe I saw Jim Rech post this...


_________________
Cheers,<font size=+2><font color="red"> Nate<font color="blue"> Oliver</font></font></font>
This message was edited by NateO on 2003-01-22 20:57

 

[aldo]

Nate, you da man!!!

Thanks so very much. Your first routine was exactly what I was looking for. Very cool.

Aldo

 

[aldo]

Okay, so this code is all well and good and then I notice the undo feature is disabled after I copy, paste and return to normal with the subroutine running. I had forgotten that running macros caused this behavior.

Is there any way to store and/or restore the undo history? Perhaps even omitting from that history the changes which the subroutine creates.

The highlighting feature is extremely helpful, but the loss of undo renders it unsafe for my application.

-Aldo
This message was edited by aldo on 2003-01-23 12:29

 

[aldo]

Here is my code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Application.CutCopyMode Then Exit Sub

On Error Resume Next

x = Target.Column
Range("a" & Target.Row, "az" & Target.Row).Select
Range(Cells(Target.Row, x), Cells(Target.Row, x)).Activate

End Sub

-Aldo
This message was edited by aldo on 2003-01-23 15:51

 

[aldo]

It seems to work fine, but it needs just a little refinement

1)The range.select line needs to be something similar to:
“rows(“Target.Row:Target.Row).Select
but something that actually works to highlight the entire row

2) The addition of an if..then statement which aborts the subroutine if multiple cells are selected.

The plusses are there. This will not interfere with conditional formatting already existing on the sheet and it does not interfere with either the copy/paste functions or the undo feature.

-Aldo

 

[aldo]

Well I ended up with a routine which only runs the highlight when I use the cursor keys. It consists of this in the worksheet module:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.OnKey "{RIGHT}", "HighlightRight"
Application.OnKey "{LEFT}", "HighlightLeft"
Application.OnKey "{UP}", "HighlightUp"
Application.OnKey "{DOWN}", "HighlightDown"
End Sub

And this in module 1:
Sub HighlightRight()
On Error Resume Next
x = ActiveCell.Column
y = ActiveCell.Row
Range("a" & y, "az" & y).Select
Range(Cells(ActiveCell.Row, x + 1), Cells(ActiveCell.Row, x + 1)).Activate
End Sub
Sub HighlightLeft()
On Error Resume Next
x = ActiveCell.Column
y = ActiveCell.Row
Range("a" & y, "az" & y).Select
Range(Cells(ActiveCell.Row, x - 1), Cells(ActiveCell.Row, x - 1)).Activate
End Sub
Sub HighlightUp()
On Error Resume Next
x = ActiveCell.Column
y = ActiveCell.Row
Range("a" & y - 1, "az" & y - 1).Select
Range(Cells(y - 1, x), Cells(y - 1, x)).Activate
End Sub
Sub HighlightDown()
On Error Resume Next
x = ActiveCell.Column
y = ActiveCell.Row
Range("a" & y + 1, "az" & y + 1).Select
Range(Cells(y + 1, x), Cells(y + 1, x)).Activate
End Sub


Problem:
I do not want the routine to run when I switch to another sheet.

-Aldo
This message was edited by on 2003-01-23 19:53

 

[NateO]

Howdy Aldo, probably want a little reset, something like:<pre>
Private Sub Worksheet_Deactivate()
Application.OnKey "{RIGHT}"
Application.OnKey "{LEFT}"
Application.OnKey "{UP}"
Application.OnKey "{DOWN}"
End Sub</pre>

In the same worksheet module. Hope this helps.

Edit: Also, I would advise you to change:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

to

Worksheet_Activate()

There's no need to reassign the procedure to a key stroke for every change in selection, you're bogging down your worksheet unnecessarily.

_________________
Cheers,<font size=+2><font color="red"> Nate<font color="blue"> Oliver</font></font></font>
This message was edited by NateO on 2003-01-23 19:44

 

[aldo]

Thanks for the worksheet_activate info. Works great.

Is there code which would realize that I had switched to another workbook that is and then exit from the routine? I only want it to work on one specific sheet on one workbook.

-aldo
This message was edited by aldo on 2003-01-23 20:07

 

[NateO]

Howdy aldo, you could try placing the following workbook procedures in the ThisWorkbook module:

<pre>
Private Sub Workbook_WindowActivate(ByVal Wn As Window)
If ActiveSheet.Index = 3 Then 'Your sheet's location
Application.OnKey "{RIGHT}", "HighlightRight"
Application.OnKey "{LEFT}", "HighlightRight"
Application.OnKey "{UP}", "HighlightRight"
Application.OnKey "{DOWN}", "HighlightRight"
End If
End Sub

Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
Application.OnKey "{RIGHT}"
Application.OnKey "{LEFT}"
Application.OnKey "{UP}"
Application.OnKey "{DOWN}"
End Sub</pre>

Hope this helps.