[ExcelVBA] Using an array to highlight select cells

 

I am hitting a wall on this one. I have an array that I am using to go through a worksheet to select and highlight rows. My problem is that there are two instances of the item in the array and my code only finds the first instance. Second I need to input some error handling so that if the array item is not in the worksheet the code will continue.

 

I am hoping these answers are simple for those of you who program on a regular basis. I have been working on this on need to finish it up but my eyes are crossing. I am pasting the code below.

 

Sub Highlight()
    Dim HighL As Range
   
   
    '.HighL = Worksheet.ActiveCell.Cells(1, 28)
    Range(ActiveCell, ActiveCell.Offset(0, 27)).Select
    Application.CutCopyMode = False
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End Sub
Sub HighlightSelRows()
    Dim vList, lArrCounter As Long, wst As Worksheet
    Dim rngFound As Range, rngToHighlight As Range, sFirstAddress As String
    Dim rngRow As Range
   
    Application.ScreenUpdating = False
   
   
    vList = Array("   Management/Administrators", "   Nursing", "   Health, Professional, Technical", "   Non Management", "   Clerical", "   Allocated/Other Transfers", "   Total Contract Labor FTE")
   
       For Each wst In ActiveWorkbook.Worksheets
            If ActiveWorkbook.Name = "TOC" Then
            Else
            End If
        For lArrCounter = LBound(vList) To UBound(vList)
            With Intersect(wst.UsedRange, wst.Columns("A")) 'wst.UsedRange.Columns("A").Cells
                Set rngFound = .Find( _
                                What:=vList(lArrCounter), _
                                Lookat:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=True)
                If Not rngFound Is Nothing Then
                    sFirstAddress = rngFound.Address
                   
                    If rngToHighlight Is Nothing Then
                        Set rngToHighlight = rngFound
                    Else
                        'On Error Resume Next

                        'we can only have one range reference per row.
                        If Intersect(rngToHighlight, rngFound.EntireRow) Is Nothing Then
                            Set rngToHighlight = Union(rngToHighlight, rngFound)
                        End If
                End If
               
                Set rngFound = .FindNext(After:=rngFound)
               
                Do Until rngFound.Address = sFirstAddress
                    If Intersect(rngToHighlight, rngFound.EntireRow) Is Nothing Then
                        Set rngToHighlight = Union(rngToHighlight, rngFound)
                    End If
                    Set rngFound = .FindNext(After:=rngFound)
                Loop
            End If
                If rngFound Is Nothing Then
                    'Worksheet.rngFound.Activate
                Else
                    rngFound.Select
                End If
                Call Highlight
        End With
    Next lArrCounter
   
    If Not rngToHighlight Is Nothing Then
        'we can't use a non contigous 3D rrange so we have to delete
        'before looping onto the next worksheet
        'rngToDelete.EntireRow.Delete
        'Application.Cut.Row =CopyMode = False
              

   
        'the referenced range has been disposed; we have to 'clearl the reference to it.
        'before we iterate onto the nextworksheet
        Set rngToDelete = Nothing
    End If

    Next wst
    'If rngFound Is Nothing Then GoTo EndOfProg
EndOfProg:
    Application.ScreenUpdating = True
   
End Sub

 

__._,_.___

Reply via web post

Reply to sender

Reply to group

Start a New Topic

Messages in this topic (1)

Recent Activity:

• New Members 1

Visit Your Group

----------------------------------
Be sure to check out TechTrax Ezine for many, free Excel VBA articles! Go here: http://www.mousetrax.com/techtrax to enter the ezine, then search the ARCHIVES for EXCEL VBA.

----------------------------------
Visit our ExcelVBA group home page for more info and support files:
http://groups.yahoo.com/group/ExcelVBA

----------------------------------
More free tutorials and resources available at:
http://www.mousetrax.com

----------------------------------

Switch to: Text-Only, Daily Digest • Unsubscribe • Terms of Use • Send us Feedback

.

__,_._,___