Function to Highlight Specific Cells Multiple Times In Loop-CodePudding

Currently I am calling each specific cell asking for them to change the cell color to be yellow, is there a function that I can write that calls each of these cells to be highlighted? Here is my code. I have a lot of variables that are defined in other subs and not in this one if there is a variable does not appear to be defined.

I also have a long if statement below that has repeating lines of code, but I am not sure I can make those into a function since they all equal different values

 Global sysrow As Integer, sysnum As String, specmin As Integer, specmax As Integer, formula As Integer, wsName As String
 Global coherencelengrow As Integer, tunrangerow As Integer, averagepowerrow As Integer, sweeprterow As Integer, kclockctrow As Integer, kclockdepthrow As Integer, kclockjitter As Integer, scopefile As Integer, spectrogramdir As Integer, snapdownvol As Integer
 Global coherencelength As Integer, tuningrange As Integer, power As Integer, sweeprate As Integer, kclockcount As Integer, kclockdepth As Integer

 Sub updateWD() 
 Dim tuningr As Range, filename As String, spectro_directory As String, percentvol As Variant

 Worksheets(sysnum).Cells(coherencelengrow, specmin) = coherencelength
 Worksheets(sysnum).Cells(coherencelengrow, specmin).Interior.Color = vbYellow
 For Each tuningr In ActiveSheet.Range("B1:B500").Cells ' for loop needed to prevent from skipping over second row of wavelenght tuning range
    If tuningr.value = "Wavelength Range" Then
    tuningr(1, 3).value = tuningrange 
    tuningr(1, 3).Interior.Color = vbYellow
    End If
 Next tuningr
 Worksheets(sysnum).Cells(averagepowerrow, specmin) = power
Worksheets(sysnum).Cells(averagepowerrow, specmin).Interior.Color = vbYellow
 Worksheets(sysnum).Cells(kclockdepthrow, specmin) = kclockdepth
Worksheets(sysnum).Cells(kclockdepthrow, specmin).Interior.Color = vbYellow
 Worksheets(sysnum).Cells(kclockjitter, specmin) = kclockcount
Worksheets(sysnum).Cells(kclockjitter, specmin).Interior.Color = vbYellow
 Worksheets(sysnum).Cells(kclockctrow, specmin) = kclockcount
Worksheets(sysnum).Cells(kclockctrow, specmin).Interior.Color = vbYellow
 Worksheets(sysnum).Cells(sweeprterow, specmin) = sweeprate
Worksheets(sysnum).Cells(sweeprterow, specmin).Interior.Color = vbYellow

 If wsName = "AXP-3" And sweeprate < 50 Then
    For Each percentvol In ActiveSheet.Range("B1:B500").Cells
        If percentvol.value = "Percent Snapdown Voltage" Then
        percentvol(1, 5).value = "95"
        percentvol(1, 5).Interior.Color = vbYellow
        End If
    Next percentvol
 ElseIf wsName = "AXP-3" And sweeprate = 50 Then
  filename = "Test_50-3"
Worksheets(sysnum).Cells(scopefile, formula) = filename
Worksheets(sysnum).Cells(scopefile, formula).Interior.Color = vbYellow
spectro_directory = "Test_50-3_spectrogram.set"
Worksheets(sysnum).Cells(spectrogramdir, formula) = spectro_directory
Worksheets(sysnum).Cells(spectrogramdir, formula).Interior.Color = vbYellow
    For Each percentvol In ActiveSheet.Range("B1:B500").Cells
    If percentvol.value = "Percent Snapdown Voltage" Then
        percentvol(1, 5).value = "98"
        percentvol(1, 5).Interior.Color = vbYellow
    End If
Next percentvol
 ElseIf wsName = "AXP-3" And sweeprate = 100 Then
filename = "Test_100-3"
Worksheets(sysnum).Cells(scopefile, formula) = filename
Worksheets(sysnum).Cells(scopefile, formula).Interior.Color = vbYellow
spectro_directory = "Test_100-3_spectrogram.set"
Worksheets(sysnum).Cells(spectrogramdir, formula) = spectro_directory
Worksheets(sysnum).Cells(spectrogramdir, formula).Interior.Color = vbYellow
    For Each percentvol In ActiveSheet.Range("B1:B500").Cells
    If percentvol.value = "Percent Snapdown Voltage" Then
        percentvol(1, 5).value = "110"
        percentvol(1, 5).Interior.Color = vbYellow
    End If
Next percentvol
 ElseIf wsName = "AXP-3" And sweeprate = 200 Then
filename = "Test_200-3"
Worksheets(sysnum).Cells(scopefile, formula) = filename
Worksheets(sysnum).Cells(scopefile, formula).Interior.Color = vbYellow
spectro_directory = "Test_200-3_spectrogram.set"
Worksheets(sysnum).Cells(spectrogramdir, formula) = spectro_directory
Worksheets(sysnum).Cells(spectrogramdir, formula).Interior.Color = vbYellow
    For Each percentvol In ActiveSheet.Range("B1:B500").Cells
    If percentvol.value = "Percent Snapdown Voltage" Then
        percentvol(1, 5).value = "110"
        percentvol(1, 5).Interior.Color = vbYellow
    End If
Next percentvol
 End If

 End Sub

CodePudding user response：

You can definitely improve this code with a Sub.

Here's how I would do that:

Sub HighlightIf(SearchRange As Range, Condition As String, OffsetColumn As Long, SetValue As Variant, Optional HighlightColor As Long = vbYellow)
    'Looping through each cell in the given search range
    Dim Cell As Range
    For Each Cell In SearchRange.Cells
        'Skip cells containing worksheet errors like #DIV/0! or #NAME?
        If Not IsError(Cell.Value) Then
            'Compare the cell value to the given search condition
            If Cell.Value = Condition Then
                'In the same row as this cell, move over a number of columns equal to OffsetColumn - 1
                'In that cell, enter the given value and then highlight it
                Cell(1, OffsetColumn).Value = SetValue
                Cell(1, OffsetColumn).Interior.Color = HighlightColor
            End If
        End If
    Next
End Sub

This works the same as your For Loop, you just need to tell it what to look for and what to fill into the highlighted cells. Using variables instead of hardcoded "95" or "98".

Here's how to use it in your code:

HighlightIf ActiveSheet.Range("B1:B500"), "Percent Snapdown Voltage", 5, "110", vbYellow

I have gone ahead and refactored your code to use the sub as well as make use of With blocks to simplify some of the repeated lines. Once I did so, I noticed that the only thing changing in the If Statement is the output value (e.g. "95","98","110"), which means that it makes more sense to save the changing output value into a variable and then after the If Statement, use the variable as an argument in the sub.

Sub updateWD()
    Const HighlightCondition As String = "Percent Snapdown Voltage"

    With Worksheets(sysnum).Columns(specmin)
        .Cells(coherencelengrow) = coherencelength

        'needed to prevent from skipping over second row of wavelenght tuning range
        HighlightIf ActiveSheet.Range("B1:B500"), "Wavelength Range", 3, tuningrange

        .Cells(averagepowerrow) = Power
        .Cells(kclockdepthrow) = kclockdepth
        .Cells(kclockjitter) = kclockcount
        .Cells(kclockctrow) = kclockcount
        .Cells(sweeprterow) = sweeprate
        Union( _
            .Cells(coherencelengrow), _
            .Cells(averagepowerrow), _
            .Cells(kclockdepthrow), _
            .Cells(kclockjitter), _
            .Cells(kclockctrow), _
            .Cells(sweeprterow) _
        ).Interior.Color = vbYellow
    End With
    
    Dim filename As String
    Dim spectro_directory As String
    Dim HighlightOthers As Boolean
    Dim HighlightValue As String
    
    If wsName = "AXP-3" Then
        Select Case sweeprate
        Case Is < 50
            HighlightValue = "95"
    
        Case 50
            filename = "Test_50-3"
            spectro_directory = "Test_50-3_spectrogram.set"
            HighlightValue = "98"
            HighlightOthers = True
            
        Case 100
            filename = "Test_100-3"
            spectro_directory = "Test_100-3_spectrogram.set"
            HighlightValue = "110"
            HighlightOthers = True
            
        Case 200
            filename = "Test_200-3"
            spectro_directory = "Test_200-3_spectrogram.set"
            HighlightValue = "110"
            HighlightOthers = True
        End Select
    
        If HighlightOthers Then
            With Worksheets(sysnum).Columns(Formula)
                .Cells(scopefile) = filename
                .Cells(scopefile).Interior.Color = vbYellow
                .Cells(spectrogramdir) = spectro_directory
                .Cells(spectrogramdir).Interior.Color = vbYellow
            End With
        End If
        
        If HighlightValue <> "" Then HighlightIf ActiveSheet.Range("B1:B500"), HighlightCondition, 5, HighlightValue
    End If
End Sub