Macro Question


Posted by Chris Thompson on October 17, 2001 6:37 AM

Hello there.. Hopefully someone can help.. I want to be able to have the following functionality coded into a macro:

Select(or highlight) all rows with the value of "x" in row A.

OR put another way:

Highlight an entire row if the value of row A is "x".

Thanks in advance for your help!

Chris Thompson
thompson@bit-net.com

Posted by Jonathan on October 17, 2001 5:07 PM

Here's a start: it will highlight a particular row if that cell is selected and there's an 'x' in it:

If ActiveCell.Value = "x" Then ActiveCell.EntireRow.Select

I'm working on one that will do what you want - select several rows if several cells in column A have x's in them - but it's not quite correct yet. You're welcome to view it if you want: maybe you can tweak it to finish it. Just ask.

HTH

Posted by Jonathan on October 17, 2001 11:41 PM


OK. I assume you mean in "column" A, but it makes little difference. This was an interesting puzzle to figure out. The tricky part was figuring out how Excel wanted to 'hear about' the rows that should be selected at the end. Of course, there may be other ways to have accomplished the same ends. There usually are many ways to solve any coding problem.

Here the x's can be in any cell whatsoever. The only limitation I'm aware of is that the selection must be contiguous (I haven't figured out how to 'talk' to that yet).

Also, I'm looking for a single 'x'; if a cell contains "xx" or "x x" or "xy" it will not be highlighted.


Sub HighliteRow()
' Doesn't work on non-contiguous selections yet

On Error GoTo HighliteRow_Error

Dim MyStr As String
Dim MySelection As Range
Dim i As Long, P As Long

' If selection is only one cell, deal with it here
If Selection.Count = 1 Then
If ActiveCell.Value = "x" Then
ActiveCell.EntireRow.Select
Else
MsgBox "The selection does not contain an 'x'", , "No 'x'"
End If
Exit Sub
End If

' If selection is multiple cells, make a string containing their
' row numbers in a certain formation used by the Range object later
For i = 1 To Selection.Count
If Selection.Cells(i).Value = "x" Then
MyStr = MyStr & Selection.Cells(i).Row & ":" & _
Selection.Cells(i).Row & ","
End If
Next i

If MyStr = "" Then
MsgBox "There was no 'x' in the selection", , "No 'x'"
Else
' Remove the final comma
MyStr = Left(MyStr, Len(MyStr) - 1)
End If

If MyStr = "" Then
' Do nothing
Else
Set MySelection = Range(MyStr)
MySelection.Select
End If

ThisWayOut:
Exit Sub

HighliteRow_Error:
MsgBox "Error # : " & Err.Number & vbCrLf & vbCrLf & _
Err.Description, , "Error Report"
Resume ThisWayOut

End Sub


Some of the stuff near the end could probably be combined to make fewer total lines.

Enjoy!



Posted by Budai on October 18, 2001 5:17 AM


Here are two ways.
One by using a loop, the other without using a loop. If you have a lot of data to process, the one without the loop will probably be a bit quicker.

Sub Select_X_Rows_WithLoop()
Dim col As Range, cell As Range, rng As Range
Set col = Intersect(ActiveSheet.UsedRange, Columns(1))
For Each cell In col
If cell.Value = "x" Then
If Not rng Is Nothing Then
Set rng = Union(cell, rng)
Else
Set rng = cell
End If
End If
Next
rng.EntireRow.Select
End Sub

Sub Select_X_Rows_NoLoop()
Dim col As Range
Set col = Intersect(ActiveSheet.UsedRange, Columns(1))
Application.ScreenUpdating = False
Columns(1).Insert
With col.Offset(0, -1)
.FormulaR1C1 = "=IF(RC[1]=""x"",""x"",0)"
On Error Resume Next
.SpecialCells(xlCellTypeFormulas, 2).EntireRow.Select
On Error GoTo 0
.EntireColumn.Delete
End With
End Sub