Re: [ExcelVBA] RE: Using an array to highlight select cells

 

Dear Mark

Thankyou for saying thankyou. 

Dear db

Here is a version using a Collection. This runs 0.3 milliseconds faster on my test worksheet than my original code but saves about 10 minutes for hunting down the scripting dll that contains the Dictionary which you suggested.

Sub HighlightIfMatchInArray_V2()

Dim nListindex As Long, vList As Variant, clxList As New Collection

Dim oSheet As Worksheet, rCell As Range, rRangeToSearch As Range

    vList = Array("   Management/Administrators", "   Nursing", "   Health, Professional, Technical", "   Non Management", "   Clerical", "   Allocated/Other Transfers", "   Total Contract Labor FTE")

    For nListindex = 0 To UBound(vList) - 1

        clxList.Add vbYellow, Trim(vList(nListindex))

    Next nListindex

    For Each oSheet In ActiveWorkbook.Worksheets

        oSheet.Activate

        Set rRangeToSearch = Range("a1", "aa999")

        rRangeToSearch.Interior.Color = xlNone

        For Each rCell In rRangeToSearch.Columns("a").Cells

            On Error Resume Next

            rRangeToSearch.Rows(rCell.Row).Interior.Color = clxList(Trim(rCell.Value))

            On Error GoTo 0

        Next rCell

    Next oSheet

End Sub

Note the line   clxList.Add vbYellow, Trim(vList(nListindex)) gives an opportunity to apply different colors for one or more list items.

Last, apologies everyone for the large text. I am blaming this on the new version of Yahoo Mail whose finer points seem to have eluded both myself and the (obviously trainee) programmer who wrote the new software.

Regards

Derek Turner

England +++

On Friday, 22 November 2013, 13:15, Mark Bacheldor <m_bacheldor@yahoo.com> wrote:

 

db,

 

The program loops through each worksheet looking for what is in the array. If it finds a match it highlights the row from Col A to Col AB.

 

I have two issues that I need to solve. The first is that the program as it stands will only find the first match and then will move to the next array item. The second issue is when there is not a match the program error's out.

I am putting this together for a co-worker and want to finish it be fore I leave. I have accepted a position at another company and don't want to leave this unfinished.

 

I hope it is a simple fix.

 

Thank you,

 

Mark

From: "dbraithwaite@charter.net" <dbraithwaite@charter.net>
To: ExcelVBA@yahoogroups.com
Sent: Thursday, November 21, 2013 7:39 PM
Subject: [ExcelVBA] RE: Using an array to highlight select cells

 

Hi

Not clear what you are trying to do.

Reading between the lines, I think this your problem statement

"For each sheet in the workbook,

Highlight columns A-AA on each row where column A matches one of the items in the array"

Is this what the program is to do ?

db

---In ExcelVBA@yahoogroups.com, <m_bacheldor@...> wrote:

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

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

.

__,_._,___