VBA - problems with cell formatting multiple IF statements

[wjvghost]

Hello,

I am trying to make a custom conditional formatting which does the following:

Check if Columns D and E are equal to each other.

If they are equal, then check if they are between a value of 500 to 2000. If all this is met then the cells turn green.

I have a second part to it which changes everything outside of those constraints to red.

It is changing parts of my numbers to red even though they are within the parameters I set.

I am not sure if I have done something wrong, but for some reason I can't seem to understand it.

Sub condTest()
Dim lastRow As Long
Dim dRange As Range
Dim Cell As Range
    
    With Worksheet
  
        lastRow = Cells(Rows.Count, "D").End(xlUp).Row
        Set dRange = Range("D2:D" & lastRow)

    End With
    If Range("D2").Value = 0 Then
    Exit Sub
    End If

    For Each Cell In dRange
        Cell.Activate
            If Cell.Value <> Cell.Offset(0, 1) Then
                Cell.Style = "Bad"
                Cell.Offset(0, 1).Style = "Bad"
            End If
            
            If Cell.Value < 500 Or Cell.Value > 2000 And Cell.Value = Cell.Offset(0, 1).Value Then
                Cell.Style = "Bad"
                Cell.Offset(0, 1).Style = "Bad"
            End If
    Next Cell
        
    Range("A1").Select
    ActiveWindow.SmallScroll Up:=1048576
End Sub

The part which turns the cells green saying they are "ok" works fine, but this part which changes the style to "Bad" if it is not correct is overwriting the green formatting and I am not sure why.

I have been staring at this for a while, so it may be glaring me in the face but I can't seem to figure it out.

/edit: these values are being returned from a GetDetailsOf object from another macro, if that makes any difference at all.

 

[Joe4]

Is there some reason why you don't want to use Conditional Formatting? That is much more efficient than using Loops.
The formula would just be something like:

=AND(D1=E1,D1>=500,D1<=2000)

If it needs to be VBA, you can assign Conditional Formatting via VBA. If you turn on the Macro Recorder and record yourself entering the CF rules, you will have most of the code that you need.
You may just need/want to limit it to the populated range (which you can find the last row pretty easily like this):

lastRow = Cells(Rows.Count,"D").End(xlUp).Row

 

[wjvghost]

I have tried to use Conditional Formatting rules before, and I was unable to figure out how to apply the rule to a range.

Basically, these columns will get populated more or less depending on how many files reside in a folder.

It could be ten files or 10,000 and I would prefer it to be created in VBA so that the amount of rules needed are only for the populated rows.

Also, it might be worth mentioning that the CF rules don't like to apply to the columns. I think it may have something to do with the way the columns are populated.

The last line from my original post describes the way they are called:

A snippet of another macro:

      objFolder.GetDetailsof(strFileName, 162)
      objFolder.GetDetailsof(strFileName, 164)

162 and 164 correspond to the "width" and "height" file properties. I am not sure if these are being recognized as "true" numbers which would possibly explain my issue, but I don't know how to fix that.

 

[Joe4]

I don't know what your "GetDetailsof" object is doing.
Is that just pulling back data from another source into the Excel file?

As I mentioned, you do not need to know what row the data ends on ahead of time, you can let the code figure it out.
Just run this code on your sheet with data, and it should do what you want.

Sub MyCFMacro()

    Dim lr As Long
    Dim rng As Range
    
'   Find last row in column D with data
    lr = Cells(Rows.Count, "D").End(xlUp).Row
    
'   Set range to format
    Set rng = Range("D1:E" & lr)
    rng.Select

'   Set green conditional formatting
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=AND($D1=$E1,$D1>=500,$D1<=2000)"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 5287936
        .TintAndShade = 0
    End With
    
'   Set red conditional formatting
    Selection.FormatConditions(1).StopIfTrue = False
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=OR($D1<>$E1,$D1<500,$D1>2000)"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    
End Sub

Note that I got all the code except for the part that finds the last row and sets the range with the Macro Recorder!
It is a great tool to take advantage of.

 

[wjvghost]

Apologies. I was getting ready to leave work and did not give a fully detailed response.

The GetDetailsOf is a reference from a module using this code:

Dim strPath
Dim iResult As Integer
Dim vArr As Variant
Dim objFolder As Object
Dim objShell As Object
Dim rowIndex As Integer
Dim lngCount As Long

    Set Worksheet = Worksheets("Sheet1")
    col_cnt = Worksheet.UsedRange.Columns.Count
        If col_cnt = 0 Then
            col_cnt = 1
        End If
    Application.ScreenUpdating = False
    Worksheet.Range(Worksheet.Cells(2, 1), Worksheet.Cells(Worksheet.UsedRange.Rows.Count, col_cnt)).Value = ""
    Application.ScreenUpdating = True

    Application.FileDialog(msoFileDialogFolderPicker).Title = _
    "Select a Folder"

    Application.FileDialog(msoFileDialogFolderPicker).Show

    Set objShell = CreateObject("Shell.Application")
    On Error Resume Next
    Set objFolder = objShell.Namespace(Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1))
    Application.ScreenUpdating = False
    Worksheets(1).Activate

     Cells(1, 1) = objFolder.GetDetailsof(objFolder.Items, 0)
     Cells(1, 2) = objFolder.GetDetailsof(objFolder.Items, 2)
     Cells(1, 3) = objFolder.GetDetailsof(objFolder.Items, 1) + " (kb)"
[COLOR=#ff0000]     Cells(1, 4) = objFolder.GetDetailsof(objFolder.Items, 162)
     Cells(1, 5) = objFolder.GetDetailsof(objFolder.Items, 164)[/COLOR]
     Cells(1, 6) = objFolder.GetDetailsof(objFolder.Items, 10)

    For Each strFileName In objFolder.Items
      Cells(rowIndex + 2, 1) = objFolder.GetDetailsof(strFileName, 0)
      Cells(rowIndex + 2, 2) = objFolder.GetDetailsof(strFileName, 2)
      Cells(rowIndex + 2, 3) = objFolder.GetDetailsof(strFileName, 1)
      Cells(rowIndex + 2, 4) = objFolder.GetDetailsof(strFileName, 162)
      Cells(rowIndex + 2, 5) = objFolder.GetDetailsof(strFileName, 164)
      Cells(rowIndex + 2, 6) = objFolder.GetDetailsof(strFileName, 10)
     rowIndex = rowIndex + 1
     lngCount = lngCount + 1
    Next
End Sub

This code is run on a Windows 7 operating system, however on a Windows 10 system (my home computer) it returns different values.

I did some more testing before I left work today, and the problem is from the way these values are added from this module.

Excel does not recognize these as "true" numbers, but if I key in the information as shown then it will run the conditional formatting sequence perfectly.

It's very odd indeed. I will do more testing tomorrow when I get my development copy of the module back in front of me.

Again on Windows 7, Columns D and E return width and height, but on Windows 10 I am seeing it return Due Date and File Count. I am only explaining this in case anyone tries using the module listed above. This module also is run independently of the one which is performing conditional formatting.

 

[wjvghost]

Ok so the problem is not that the conditional formatting is wrong or doesn't work.

The problem is that when the values are being added to each column under width and height, they are being stored as text and not numbers.

I have tried several methods of converting the columns to numbers, but nothing is working for me.

A simple =ISNUMBER(D2) returns false as expected.

I cannot use the Convert Text to Columns method or multiplying the column ranges by 1 using a Paste Special > Multiply method either.

I'm at a loss on how to proceed with this.

 

[Joe4]

If they are BOTH text (columns D and E), the equals part should be fine. It is the less than/greater than parts we need to address.
Numbers entered as Text can be converted to Numbers using the VALUE function.

So just change the Conditional Formatting rule to:

=AND($D1=$E1,VALUE($D1)>=500,VALUE($D1)<=2000)

 

[wjvghost]

I figured out the issue.

Since these properties are being obtained from objects (files in a folder), they are stored as text.

It doesn't help that I didn't provide all pertinent information.

I had another macro that was running before this module ran, which was renaming these columns.

When the width and height properties were being obtained from the file objects, they were being returned as "2000 pixels" and I had another module replacing "pix*" with nothing.

The problem still remained.

I eventually just used a simple MsgBox (Cell) line to see what the cell value was actually being returned as and it displayed ?2000 as the value.

At that point I realized there was an unknown/invalid character hidden in front of the value which prevented any method I used of converting the columns to numbers.

I just used a simple method to shave off the first characters of every cell in the filled range and everything is working perfectly now.

    For Each Cell In dRange
        Cell.Value = Right(Cell, Len(Cell) - 1)
        Cell.Offset(0, 1).Value = Right(Cell.Offset(0, 1), Len(Cell.Offset(0, 1)) - 1)
    Next Cell

After adding this bit before the conditional formatting, everything is now returning true of =ISNUMBER.

It was a very odd and very specific problem.

 

[Joe4]

That is very odd.
Glad you figured it all out, and hopefully learned a few "tricks" along the way.

 

[wjvghost]

I did learn some things.

Your advice and help worked in my favor as well once this was figured out by the way.

Thanks for the time and patience