Macros highlighting cells, some help needed

[son_goku]

Hello, I'm trying to write a macro(s) to highlight and sum up particular cells:
1) blank cells
2) cells two columns to the left from a cell containing "TRUE"
Everything should be clear on the scrshot below:

Here is some code I was trying to use (as two separate macros):

[FONT=Calibri][SIZE=3]Sub MissingValues()[/SIZE][/FONT]
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>
[FONT=Calibri][SIZE=3]'[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]' MissingValues Macro[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]' Finds all missing values within the range specified,[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]' highlights the empty cells with blue background colour, font white and bold.[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]' Also, counts missing values for every column and row.[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]'[/SIZE][/FONT]
<o:p></o:p>
[FONT=Calibri][SIZE=3]'[/SIZE][/FONT]
<o:p></o:p>
[FONT=Calibri][SIZE=3]Dim valuesRange As Range[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]Dim i As Integer[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]Dim j As Integer[/SIZE][/FONT]
<o:p></o:p>
<o:p></o:p>
[SIZE=3][FONT=Calibri]   On Error Resume Next[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   Application.DisplayAlerts = False[/FONT][/SIZE]
 
[SIZE=3][FONT=Calibri]   Set valuesRange = Application.InputBox _[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   (Prompt:="Please select the range of values:", _[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   Title:="SPECIFY RANGE", Type:=8)[/FONT][/SIZE]
<o:p></o:p>
[SIZE=3][FONT=Calibri]   On Error GoTo 0[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   Application.DisplayAlerts = True[/FONT][/SIZE]
<o:p></o:p>
[SIZE=3][FONT=Calibri]       If valuesRange Is Nothing Then[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]           Exit Sub[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]       Else[/FONT][/SIZE]
 
[SIZE=3][FONT=Calibri]           For Each Cell In valuesRange[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]               If IsEmpty(Cell) = True Then[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]               ' If Len(Trim(Active.Cell)) = 0 Then[/FONT][/SIZE]
 
[SIZE=3][FONT=Calibri]                   With Selection.FormatConditions(1).Font[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                       .ThemeColor = xlThemeColorDark1[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                   End With[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                   With Selection.FormatConditions(1).Interior[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                       .Color = 12611584[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                   End With[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]           Exit For[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]               End If[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]           Next Cell[/FONT][/SIZE]
 
 
[SIZE=3][FONT=Calibri]         '  For i = 0 To Rows[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]        '[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]       '        For j = 0 To Cols[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]      '[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]     '              If active/current.cell Then[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]    '               ' IsEmpty[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   '[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]               '       With Selection.FormatConditions(1).Font[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                '          .ThemeColor = xlThemeColorDark1[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                 '     End With[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                  '    With Selection.FormatConditions(1).Interior[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                   '       .Color = 12611584[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                    '  End With[/FONT][/SIZE]
[FONT=Calibri][SIZE=3]'[/SIZE][/FONT]
[SIZE=3][FONT=Calibri]               '    End If[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]              '[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]             '  Next j[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]            '[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]           'Next i[/FONT][/SIZE]
 
[SIZE=3][FONT=Calibri]       End If[/FONT][/SIZE]
<o:p></o:p>
<o:p></o:p>
[FONT=Calibri][SIZE=3]End Sub[/SIZE][/FONT]

and

[FONT=Calibri][SIZE=3]Sub Outliers()[/SIZE][/FONT]
<o:p></o:p>
[FONT=Calibri][SIZE=3]'[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]' Finds the outliers basing on the z-value and[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]' highlights the cells - the corresponding values (two columns to the left), not TRUEs[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]' with yellow background colour, changing the font colour to red and bolding it.[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]' Also, counts outliers for every column and per each row as well.[/SIZE][/FONT]
[FONT=Calibri][SIZE=3]'[/SIZE][/FONT]
<o:p></o:p>
[FONT=Calibri][SIZE=3]'[/SIZE][/FONT]
[SIZE=3][FONT=Calibri]   Dim valuesRange As Range[/FONT][/SIZE]
 
[SIZE=3][FONT=Calibri]   Set valuesRange = Application.InputBox _[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   (Prompt:="Please select the range of values:", _[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   Title:="SPECIFY RANGE", Type:=8)[/FONT][/SIZE]
 
[SIZE=3][FONT=Calibri]   valuesRange.Select[/FONT][/SIZE]
 
[SIZE=3][FONT=Calibri]   Selection.FormatConditions.Add Type:=xlTextString, String:="TRUE", _[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]       TextOperator:=xlContains[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   ' Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   With Selection.FormatConditions(1).Font[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]       .Color = -16776961[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   End With[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   With Selection.FormatConditions(1).Interior[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]       .Color = 65535[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   End With[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   ' Selection.FormatConditions(1).StopIfTrue = False[/FONT][/SIZE]
<o:p></o:p>
[FONT=Calibri][SIZE=3]End Sub[/SIZE][/FONT]

They won't work the way I want them to though, but at least I tried
Cheers for any help.

--EDIT--
Forgot to mention that the user has to select the range, and then everything is done within it (down the column first, then go to the next row)

 

[son_goku]

Bump

 

[son_goku]

Please, I really can't get this done...

 

[AlphaFrog]

Option Explicit

Sub Outliers()
'Format the isOutlier column where the isOutlier column = TRUE
'Format: Red background, yellow font color, bold font
'Count TRUEs and put the count six rows below selection in the isOutlier column
'Count TRUEs and put the count three columns to the right from the selection for every row.
    
'    strHeader = "IsOutlier"     ' Column Header
'    strFilter = "TRUE"          ' Filter value
'    ro = 6                      ' row offset from selection for column count (row offset)
'    co = 3                      ' column offset from selection for row count (column offset)
'    bgColor = 3   'Red          ' Background colorindex
'    fontColor = 6 'Yellow       ' Font colorindex
    
    Filter_And_Count "IsOutlier", "TRUE", 6, 3, 3, 6

End Sub

Sub MissingValues()
'Format the Values column where the Values column = BLANK
'Format: Blue background, White font color, bold font
'Count BLANKs and put the count five rows below selection in the Values column
'Count BLANKs and put the count two columns to the right from the selection for every row.
    
'    strHeader = "Values"        ' Column Header
'    strFilter = ""              ' Filter value
'    ro = 5                      ' row offset from selection for column count (row offset)
'    co = 2                      ' column offset from selection for row count (column offset)
'    bgColor = 23   'Blue        ' Background colorindex
'    fontColor = 2  'White       ' Font colorindex
    
    Filter_And_Count "Values", "", 5, 2, 23, 2
    
End Sub

Private Sub Filter_And_Count(strHeader As String, strFilter As String, _
                             ro As Long, co As Long, bgColor As Integer, fontColor As Integer)

    Dim rngSelect As Range, rngHeader As Range, rng As Range
    Dim FirstFound As String, r As Long, c As Long, Counter As Long

    ' Prompt user for a range selection
SelectRange:
    On Error Resume Next
    Application.DisplayAlerts = False
    Set rngSelect = Application.InputBox _
            (Prompt:="Please select the range:", _
            Title:="SPECIFY RANGE", Type:=8)
    On Error GoTo 0
    Application.DisplayAlerts = True
    If rngSelect Is Nothing Then Exit Sub
    
    ' Find Header columns within selection
    With rngSelect
    
        ' Search for Header
        Set rngHeader = rngSelect.Find(strHeader, .Cells(.Count), xlValues, xlWhole, xlByColumns, xlNext, False)
        If rngHeader Is Nothing Then
            ' No column header found within selection
            MsgBox "Can't highlight """ & strFilter & """ cells.", vbCritical, "No """ & strHeader & """ column selected."
            Set rngSelect = Nothing
            GoTo SelectRange  ' prompt user for new range selection
            
        Else
            ' column header is found within selection
            Application.ScreenUpdating = False
            FirstFound = rngHeader.Address      ' first column header found. Used to stop the loop later.
            
            Do
                Set rng = Intersect(rngSelect, Columns(rngHeader.Column))   ' define each Header column within user selection
                r = rng(rng.Count).Offset(ro).Row                           ' row for the column count (offset 'ro' rows below selection)
                Rows(r).HorizontalAlignment = xlCenter                      ' center align the "count" values
                c = rngHeader.Column                                        ' column of found header
                rng.AutoFilter field:=1, Criteria1:=strFilter               ' filter on strFilter cells within each Header column
                
                With rng.Offset(1).Resize(rng.Count - 1).SpecialCells(xlCellTypeVisible)    ' with just the visible filtered cells
                    With .Font
                        .Bold = True                ' bold font
                        .ColorIndex = fontColor     ' font color
                    End With
                    .Interior.ColorIndex = bgColor  ' background color
                    '.FormatConditions(1).ThemeColor = xlThemeColorDark1
                    '.FormatConditions(1).Color = 12611584
                    Cells(r, c).Value = .Cells.Count                ' column count below selection
                End With
                rng.Parent.AutoFilterMode = False                   ' clear autofilter
                Set rngHeader = rngSelect.FindNext(rngHeader)       ' find next strHeader column
            Loop Until rngHeader.Address = FirstFound               ' loop until the fist strHeader column is found again
            
            ' Count of strFilter cells within rows ("row count")
            c = rngSelect(1).Column + rngSelect.Columns.Count + co - 1              ' Column to put the "row count" in
            For r = 2 To rngSelect.Rows.Count                                       ' For each row in selection excluding header
                Counter = WorksheetFunction.CountIf(rngSelect.Rows(r), strFilter)   ' count
                If Counter Then Cells(rngSelect.Rows(r).Row, c).Value = Counter     ' put "row count" in cell if count > 0
            Next r
            Columns(c).HorizontalAlignment = xlCenter
            
            Application.ScreenUpdating = True
        End If
    End With

End Sub

 

[son_goku]

YOU. ARE. A. HERO.

Thanks a lot!! However, in fact the columns named Values in the data set example, are actually some attributes with specified names - like height, weight, length, color, brand, and so on (12 in total). But I guess I can only congratulate myself not telling that before, or just add a row after those labels with the word "Values".

Also, if I wanted the macro MissingValues to automatically fill in the blank cells with particular values - for example mean values of all others (non-blanks) in that column, would it be difficult to be implemented?

Thanks again!

 

[son_goku]

Update:

1) The macro crashes when a column has NO missing values.

2) It is probably my fault (because the example is misleading), but in the macro description I wrote:

2nd separate macro called Outliers:
Want a separate macro (not combined with the above macro)
Same as the MissingValues macro except...
Format the Values column where the isOutlier column = TRUE
Format: Red background, yellow font color, bold font

So I'd like to highlight the value corresponding to isOutlier=TRUE

Again, many thanks for your help, AlphaFrog!

 

[son_goku]

I don't quite know how to fix the first one, but I have tried to do the second one with the use of ActiveCell.Offset(0,-2) so that whenever it finds "TRUE" it should go two cells to the left and then do the formatting, but it doesn't work like that...

 

[son_goku]

Obviously, there is also issue 3) The macro crashes when a column has NO outliers, but the reason would be same as for the 1) I guess.

 

[son_goku]

Bump