Consulting

Page 1 of 2 1 2 LastLast
Results 1 to 20 of 33

Thread: Delete all conditional formatting and coloring conditional on specific rows

  1. #1
    VBAX Tutor
    Joined
    Sep 2012
    Location
    London
    Posts
    264
    Location

    Delete all conditional formatting and coloring conditional on specific rows

    Hello, everyone,
    I've been trying to make my own macro for two months, but somehow I can't do it myself.
    I am asking for your assistance on how to combine and make the conditions that I will describe.
    I have a range of cells (this is in the example I'll attach) which is Range("C3:N60") - the first thing I want is to remove absolutely all Cells.FormatConditions.Delete,
    after that I want in exactly selected rows to express given criteria for coloring these rows under the requested conditions (which I did manually in a macro)
    I would be grateful if someone could help me because I am totally desperate with this task.


    Sub test1()
    
        Range("C3:N60").Select
        Cells.FormatConditions.Delete
        
        End With
       
        Range("C4:N4").Select
        Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual _
            , Formula1:="=$A$4+50"
        Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
        With Selection.FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorLight2
            .TintAndShade = 0.799981688894314
        End With
        Selection.FormatConditions(1).StopIfTrue = False
        Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual _
            , Formula1:="=$A$4+100"
        Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
        With Selection.FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent3
            .TintAndShade = 0.799981688894314
        End With
        Selection.FormatConditions(1).StopIfTrue = False
        Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual _
            , Formula1:="=$A$4+150"
        Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
        With Selection.FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent6
            .TintAndShade = 0.799981688894314
        End With
        Selection.FormatConditions(1).StopIfTrue = False
        Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual _
            , Formula1:="=$A$4+200"
        Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
        With Selection.FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 255
            .TintAndShade = 0
        End With
        Selection.FormatConditions(1).StopIfTrue = False
        Range("C8:N8").Select
        Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual _
            , Formula1:="=$A$8+50"
        Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
        With Selection.FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorLight2
            .TintAndShade = 0.799981688894314
        End With
        Selection.FormatConditions(1).StopIfTrue = False
        Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual _
            , Formula1:="=$A$8+100"
        Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
        With Selection.FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent3
            .TintAndShade = 0.799981688894314
        End With
        Selection.FormatConditions(1).StopIfTrue = False
        Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual _
            , Formula1:="=$A$8+150"
        Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
        With Selection.FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent6
            .TintAndShade = 0.799981688894314
        End With
        Selection.FormatConditions(1).StopIfTrue = False
        Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual _
            , Formula1:="=$A$8+200"
        Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
        With Selection.FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 255
            .TintAndShade = 0
        End With
        Selection.FormatConditions(1).StopIfTrue = False
        
        Range("C3:N60").Select
        Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=LEN(TRIM(C3))>0"
        Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
        With Selection.FormatConditions(1).Interior
            .Pattern = xlNone
            .TintAndShade = 0
        End With
        Selection.FormatConditions(1).StopIfTrue = True
        Range("C2").Select
    End Sub
    Attached Files Attached Files

  2. #2
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,743
    Location
    Some things for you to think about

    Lot of redundant code removed, no need to .Select and both rows were getting the same CF

    I rearranged the CF tests in a 'get out' order

    I like .Color and .ColorIndex instead of Pattern, Tint and Shade so I changed since I was more familiar with them. Put them back if you prefer of course

    Don't think you needed the "=LEN(TRIM(C3))>0" so I left it out

    I think it's important to use .FormatConditions.Count


    Option Explicit         '   <<<<<<<<<<<<<<<<<<<
    
    
    Sub test2()
        
        With Worksheets("Blagoevgrad total")     '   <<<<<<<<<< or specific sheet
        
            .Cells.FormatConditions.Delete
        
            With Application.Union(.Range("C4:N4"), .Range("C8:N8"))
                .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:="=$A$4+200"
                .FormatConditions(.FormatConditions.Count).Interior.Color = vbRed
                .FormatConditions(.FormatConditions.Count).StopIfTrue = True
                
                .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:="=$A$4+150"
                .FormatConditions(.FormatConditions.Count).Interior.ColorIndex = 15
                .FormatConditions(.FormatConditions.Count).StopIfTrue = True
                
                .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:="=$A$4+100"
                .FormatConditions(.FormatConditions.Count).Interior.ColorIndex = 24
                .FormatConditions(.FormatConditions.Count).StopIfTrue = True
            
                .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:="=$A$4+50"
                .FormatConditions(.FormatConditions.Count).Interior.ColorIndex = 20
                .FormatConditions(.FormatConditions.Count).StopIfTrue = True
            End With
            
            .Select
            .Range("C2").Select
        End With
    End Sub
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  3. #3
    VBAX Tutor
    Joined
    Sep 2012
    Location
    London
    Posts
    264
    Location
    Hello and thank you very much for your help. But I have a question, two to be exact. 1st - can it be changed to active worksheet or say so I can insert more worksheets. The 2nd question is, after the changes on your part, range, I can see it, but then the formula a4+50 or 100 or 150 or 200, is always taken with A4, and actually I need for the next comparison to be A8 and not i don't see it anywhere like a8+50 etc. 3rd - question, can I on this line With Application.Union(.Range("C4:N4"), .Range("C8:N8")) - put more lines, for example C11:N11, C25:N25, just a few more lines. Thanks in advance! Be alive and healthy!

    P.S. I don't see the last range where I say if it's blanks, don't color anything.
    how about your suggestion for - I think it's important to use .FormatConditions.Count
    Last edited by k0st4din; 03-10-2023 at 01:11 PM.

  4. #4
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,743
    Location
    try this and see



    P.S. I don't see the last range where I say if it's blanks, don't color anything.
    It seemed that if the cell got past the Formula1:="=$A4+50" condition then it would not be CF-ed

    Option Explicit
    
    
    Sub test3()
        
        With ActiveSheet        ' Q1
        
            .Cells.FormatConditions.Delete
        
            With Application.Union(.Range("C4:N4"), .Range("C8:N8"), .Range("C11:N11"), .Range("C25:N25"))          ' Q2
    
                .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:="=$A4+200"              '   $A4 not $A$4
                .FormatConditions(.FormatConditions.Count).Interior.Color = vbRed
                .FormatConditions(.FormatConditions.Count).StopIfTrue = True
                
                .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:="=$A4+150"
                .FormatConditions(.FormatConditions.Count).Interior.ColorIndex = 15
                .FormatConditions(.FormatConditions.Count).StopIfTrue = True
                
                .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:="=$A4+100"
                .FormatConditions(.FormatConditions.Count).Interior.ColorIndex = 24
                .FormatConditions(.FormatConditions.Count).StopIfTrue = True
            
                .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:="=$A4+50"
                .FormatConditions(.FormatConditions.Count).Interior.ColorIndex = 20
                .FormatConditions(.FormatConditions.Count).StopIfTrue = True
            
           End With
            
            .Select
            .Range("C2").Select
        End With
    End Sub
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  5. #5
    VBAX Tutor
    Joined
    Sep 2012
    Location
    London
    Posts
    264
    Location
    Hello again,
    thank you very much for your help, the macro works almost 100%.
    What I noticed and did as a test is that in the whole table I have some rows (for example 33 rows) that are single (standalone), i.e. no criteria for more rows. And when I set in the macro (changed the rows) and reduced them to only one row, here -> With Application.Union - it gave me an error and didn't want to do the coloring, maybe because it's only one row.
    In the table I gave as an example: I always compare it with the number in column A and below, and these additions in the example +50,+100,+150,+200 or +30,+60,+90,+ 120, etc. I take them from a column (as a note) from column O.
    The other thing that struck me (that I hadn't thought of at all) is that if I make a few macros that run the various add-ons +50, etc., +30, etc., then every time I click for each one of the criteria, it will always erase all CFs from the previous one that is selected and always leave the last one as the selection which is not OK
    I don't know how to clear this as a problem.
    I was thinking if I make a standalone macro that first deletes all CFs and then starts enabling the criteria I want.

    Thanks in advance and I believe we will get there and finalize things. Remain available!
    Attached Files Attached Files
    Last edited by k0st4din; 03-11-2023 at 03:05 AM.

  6. #6
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,743
    Location
    I'm guessing that you didn't mention that the 4 thresholds for each line could be different and are in cols O-R

    Many of your cells have 0 length strings, which are not considered empty or = 0 for VBA

    Sub test4()
        
        With ActiveSheet
        
            With .Range("C3:N60")
                .FormatConditions.Delete
            
                .Interior.ColorIndex = xlColorIndexNone
            
                'clear any empty, but text i.e. 0 length strings
                Call .Replace(vbNullString, "###ZZZ###", LookAt:=xlWhole)
                Call .Replace("###ZZZ###", vbNullString, LookAt:=xlWhole)
            
                'clear the settings
                .Find What:=vbNullString, After:=.Cells(1, 1), LookIn:=xlFormulas, LookAt:=xlPart, _
                       SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False
                .Replace What:=vbNullString, Replacement:=vbNullString, ReplaceFormat:=False
            End With
    
    
            Call AddCF(4)
            Call AddCF(5)
            Call AddCF(6)
            Call AddCF(7)
            Call AddCF(8)
            Call AddCF(9)
            Call AddCF(17)
           
            .Select
            .Range("C2").Select
        End With
    End Sub
    
    
    
    
    Private Sub AddCF(rowNum As Long)
        Dim T1 As Long, T2 As Long, T3 As Long, T4 As Long
        Dim CFormula As String
        Dim R As Range
        
        Set R = ActiveSheet.Rows(rowNum)
        
        With R
            T1 = .Cells(1, 15).Value
            T2 = .Cells(1, 16).Value
            T3 = .Cells(1, 17).Value
            T4 = .Cells(1, 18).Value
        
            CFormula = "=$A" & .Cells(1, 1).Row & "+"
        
            Set R = R.Cells(1, 3).Resize(1, 12)
        End With
    
    
         With R
             .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:=CFormula & T4
             .FormatConditions(.FormatConditions.Count).Interior.Color = vbRed
             .FormatConditions(.FormatConditions.Count).StopIfTrue = True
             
             .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:=CFormula & T3
             .FormatConditions(.FormatConditions.Count).Interior.ColorIndex = 15
             .FormatConditions(.FormatConditions.Count).StopIfTrue = True
             
             .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:=CFormula & T2
             .FormatConditions(.FormatConditions.Count).Interior.ColorIndex = 24
             .FormatConditions(.FormatConditions.Count).StopIfTrue = True
         
             .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:=CFormula & T1
             .FormatConditions(.FormatConditions.Count).Interior.ColorIndex = 20
             .FormatConditions(.FormatConditions.Count).StopIfTrue = True
        End With
    
    
    
    
    End Sub
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  7. #7
    VBAX Tutor
    Joined
    Sep 2012
    Location
    London
    Posts
    264
    Location
    Hello
    thank you very much for the serious macro changes, but I'm afraid you misunderstood me.
    Now, the last table I sent and the addition in the columns P , Q , R - was only if you need in the calculation and tests to compare them.
    Otherwise, in these 3 columns, these values are not there, they are entered in CF. (Otherwise it's a clever idea)


    The other thing you mention about these 0's is a test file very close to the original one and the picture is almost the same as every single month ahead it will change and in every single cell there may be a value (some number).


    In the last file you sent me, I decided to try and test by plotting numbers on row 21 and when I hit the macro, nothing like coloring came out on that row.
    And the values are increased, to be +100,+200,+300,+400
    I don't understand either, why didn't you color them?
    I'm wondering why it doesn't color in the full range (after doing a check) C3:N60
    2023-03-12_090329.jpg

    I'm not that good at writing macros, but I have a feeling that you always take the values that are in/from O4:R4, and maybe I don't understand the macro and it takes its values from each row adjacent to it (so must be).


    Could you tell me, I couldn't figure this out:
    Call AddCF(4)
    Call AddCF(5)
    Call AddCF(6)
    Call AddCF(7)
    Call AddCF(8)
    Call AddCF(9)
    Call AddCF(17)
    what is he doing
    I can't figure out where you get that 4,5,6,7,8,9 and 17.
    If when the macro is pressed, everything is deleted and then it recalculates and applies the colors where needed.
    Thank you very much and I remain available.


    And to mention again, the last option is quite clever, because it will save me a lot of writing and changes of ranges of cells, columns, values.
    Thanks

  8. #8
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,743
    Location
    but I'm afraid you misunderstood me.
    Most likely


    Now, the last table I sent and the addition in the columns P , Q , R - was only if you need in the calculation and tests to compare them.
    OPQR cols implied that each row might have different thresh holds


    I'm not that good at writing macros, but I have a feeling that you always take the values that are in/from O4:R4, and maybe I don't understand the macro and it takes its values from each row adjacent to it (so must be).
    Yes, not required but easier since otherwise the 4 thresh holds would have to be passed to the sub. That was my first approach but I decided that it was not very elegant. I can put it back if it's a problem



    I can't figure out where you get that 4,5,6,7,8,9 and 17.
    The subroutine definition might give you a hint since I like to give variables meaningful names

    Private Sub AddCF(rowNum As Long)
        Dim T1 As Long, T2 As Long, T3 As Long, T4 As Long
        Dim CFormula As String
        Dim R As Range
        
        Set R = ActiveSheet.Rows(rowNum)

    In the last file you sent me, I decided to try and test by plotting numbers on row 21 and when I hit the macro, nothing like coloring came out on that row.
    I didn't spend time doing every row, I only did some that had a value in OPQR, I just didn't include row 21

           Call AddCF(15)
           Call AddCF(17)
           Call AddCF(21)

    It's easy enough to have the macro do all rows, keying off of OPRQ values (skip rows where the col O is blank


    Sub DoAllRows()
        Dim r As Long
        
        With ActiveSheet
            With .Range("C3:N60")
                .FormatConditions.Delete
            
                .Interior.ColorIndex = xlColorIndexNone
            
                'clear any empty, but text i.e. 0 length strings
                Call .Replace(vbNullString, "###ZZZ###", LookAt:=xlWhole)
                Call .Replace("###ZZZ###", vbNullString, LookAt:=xlWhole)
            
                'clear the settings
                .Find What:=vbNullString, After:=.Cells(1, 1), LookIn:=xlFormulas, LookAt:=xlPart, _
                       SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False
                .Replace What:=vbNullString, Replacement:=vbNullString, ReplaceFormat:=False
            End With
            
            For r = 3 To 60
                Call AddCF(r)
            Next r
        End With
    End Sub
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  9. #9
    VBAX Tutor
    Joined
    Sep 2012
    Location
    London
    Posts
    264
    Location
    Hi, now it is clear to me about these CFs that I have to add myself and it will be really easy to determine which lines to monitor.
    The new proposal is also good because things happen even faster.


    However, in the test, the table does not calculate correctly, which is not good for me.
    I give an example from the table itself and the last macro:
    On rows 33, 45, 47, 48, 49 - the coloring is not true.
    on
    33 -> 331+350=681, and it gives me the blue color 343 - this is not true
    45 -> 48+ 30=78, in the table 41 and 38 as values should not be in blue color, they are less than the minimum required number 78
    48 -> same situation, on 49 -> there is absolutely no way the number can be less than 853 and be red, if it is 853+30=883 I agree it should be first color, if it is 853+60=913 it should be second color etc. I agree but in this case it is not correct


    While you are writing to me, I will try the previous macro adding CF because I didn't understand it and I will try the old macro to see the result.
    2023-03-13_070537.jpg





    P.S. - Just to add because I did the tests with the previous macro and added the Call CF, but when I opened the CF itself I saw that it shuffled the lines and that's where the problem comes from. For example, if it is A47, it sends me to CF to monitor, for example, A58, and that is where the incorrect coloring comes from.I have no idea why
    Last edited by k0st4din; 03-12-2023 at 11:06 PM.

  10. #10
    VBAX Tutor
    Joined
    Sep 2012
    Location
    London
    Posts
    264
    Location
    I've been in front of this table and this macro all day.
    I feel like I'm an oligophrenic.
    What struck me was that where the colorings were not correct, they only became correct when I clicked on a specific row and then it calculated correctly.
    I have no idea why this happens.

    2023-03-13_173825.jpg

    2023-03-13_174058.jpg
    Last edited by k0st4din; 03-13-2023 at 08:43 AM.

  11. #11
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,743
    Location
    I changed the colors since it made it easier for my old eyes to see

    Capture.jpg

    Here's the way I look at Row 33


    A33 = 331

    C33 = 365


    CF rules for C33: A33 + (350/700/1050/1400)

    331 + 1400 = 1731 >>> C33 NOT > 1731

    331 + 1050 = 1381 >>> C33 NOT > 1380

    331 + 700 = 1031 >>> C33 NOT > 1031

    331 + 350 = 881 >>> C33 NOT > 681

    It seems to work and there should be no CF color. Am I missing something???


    Same for your row 9 question
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  12. #12
    VBAX Tutor
    Joined
    Sep 2012
    Location
    London
    Posts
    264
    Location
    Hello again, Paul_Hossler
    don't worry about changing the colors, I'll change them to whatever I want.


    As for the macro and accounts:
    Yes, they are correct and there are no two opinions about it.


    Please look at post number 10.
    Either I'm oligophrenic or I have some kind of problem. I'm using office 2007 (my personal preference, I can use another but I don't want to).


    In post 10 I mentioned, now I will write again, I have no idea why when I clicked somewhere in the table (inadvertently/arbitrarily selected cell) and pressed the button to activate the macro it colors the cells wrongly (I will show a picture, how it moves and calculates the wrong coloring ) because it takes another cell for comparison.
    However, when I clicked exactly in the given cell, the calculation for that same row is correct.
    This is the first time this has happened to me, it goes and selects CF chaotic cells, but not what it is told to do with that CF.
    Am I misunderstanding it or am I having some problem Paul_Hossler?
    The macro is perfect and I'm very grateful, that's the only thing that bothers me, why does it shuffle the lines, it's kind of crazy to me.


    2023-03-14_071011.jpg

    2023-03-14_074535.jpg

    P.S - I think my problem comes from the fact that I am using office 2007.I tried on newer versions and everything works fine there.
    Is there an option to tweak it to work on my version?

    I guess there are some differences in the writing of the macro itself, I can't think of anything else as a problem.
    Thanks in advance!
    Last edited by k0st4din; 03-14-2023 at 02:39 AM.

  13. #13
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,743
    Location
    What is the macro that you're using to call it?

    I see there's a [Button1] on the worksheet

    Maybe better to attach your actual workbook if you can
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  14. #14
    VBAX Tutor
    Joined
    Sep 2012
    Location
    London
    Posts
    264
    Location
    Hi, yes is a button1, the macro is in.

  15. #15
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,743
    Location
    ... and the macro is ...?

    Attached Workbook?
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  16. #16
    VBAX Tutor
    Joined
    Sep 2012
    Location
    London
    Posts
    264
    Location
    just to get home, but the thing is, I haven't reached my workbook yet. When you send me your file, with the macro in it, I try in your file, in your workbook. And when I open it with office 2007, on my computer, it gives me the wrong calculations that I showed in the pictures. When I went to the office and opened your same file in a newer version of the office suite, things calculated the right way. For this reason, I think the problem comes from office 2007, which I use all the time. And since it happened to me another time, writing a macro in a different way for different office packages, maybe this is where the problem comes from.

  17. #17
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,743
    Location
    I saved my WB as a previous version and there was a compatibility alert: "Only the first three conditions fill be displayed"

    Capture.JPG
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  18. #18
    VBAX Tutor
    Joined
    Sep 2012
    Location
    London
    Posts
    264
    Location
    Hi Paul, is there a way to do something with this macro so that it works with office 2007 as if there are no other newer editions. I'm just really desperate.
    Thank you in advance!

  19. #19
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,743
    Location
    Quote Originally Posted by k0st4din View Post
    Hi Paul, is there a way to do something with this macro so that it works with office 2007 as if there are no other newer editions. I'm just really desperate.
    Thank you in advance!
    Apparently not using CF, only other way would be hard coding the interior color. Macro can use Application.Version to figure out which method to use


    Option Explicit
    
    
    Sub DoAllRows()
        Dim r As Long
        
        Application.ScreenUpdating = False
        
        With ActiveSheet
            With .Range("C3:N60")
                .FormatConditions.Delete
            
                .Interior.ColorIndex = xlColorIndexNone
            
                'clear any empty, but text i.e. 0 length strings
                Call .Replace(vbNullString, "###ZZZ###", LookAt:=xlWhole)
                Call .Replace("###ZZZ###", vbNullString, LookAt:=xlWhole)
            
                'clear the settings
                .Find What:=vbNullString, After:=.Cells(1, 1), LookIn:=xlFormulas, LookAt:=xlPart, _
                       SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False
                .Replace What:=vbNullString, Replacement:=vbNullString, ReplaceFormat:=False
            End With
            
    '   https://www.rondebruin.nl/win/s9/win012.htm
    '            Excel 97 = 8
    '            Excel 2000 = 9
    '            Excel 2002 = 10
    '            Excel 2003 = 11
    '            Excel 2007 = 12
    '            Excel 2010 = 14
    '            Excel 2013 = 15
    '            Excel 2016 = 16
    '            Excel 2019 and Excel 365 also give you number 16
            If Application.Version > 12 Then
                For r = 3 To 60
                    Call AddCF(r)
                Next r
            Else
                For r = 3 To 60
                    Call AddInteriorColor(r)
                Next r
            End If
        End With
    
    
        Application.ScreenUpdating = True
    
    
    End Sub
    
    
    
    
    Private Sub AddInteriorColor(rowNum As Long)
        Dim T1 As Long, T2 As Long, T3 As Long, T4 As Long, T0 As Long
        Dim r As Range
        Dim c As Long
        
        Set r = ActiveSheet.Rows(rowNum)
        
        With r
            If .Cells(1, 15).Value = 0 Then Exit Sub    '   no threshholds
        
            T0 = .Cells(1, 1).Value
        
            T1 = .Cells(1, 15).Value
            T2 = .Cells(1, 16).Value
            T3 = .Cells(1, 17).Value
            T4 = .Cells(1, 18).Value
        
        
            Set r = r.Cells(1, 3).Resize(1, 12)
        End With
    
    
        With r
            For c = 1 To 12     '   r starts in col C
                If .Cells(1, c).Value >= T0 + T4 Then
                    .Cells(1, c).Interior.Color = vbRed
                ElseIf .Cells(1, c).Value >= T0 + T3 Then
                    .Cells(1, c).Interior.Color = vbYellow
                ElseIf .Cells(1, c).Value >= T0 + T2 Then
                    .Cells(1, c).Interior.Color = vbGreen
                ElseIf .Cells(1, c).Value >= T0 + T1 Then
                    .Cells(1, c).Interior.Color = vbBlue
                End If
             Next c
        End With
    End Sub
    
    
    
    
    
    
    Private Sub AddCF(rowNum As Long)
        Dim T1 As Long, T2 As Long, T3 As Long, T4 As Long
        Dim CFormula As String
        Dim r As Range
        
        Set r = ActiveSheet.Rows(rowNum)
        
        With r
            If .Cells(1, 15).Value = 0 Then Exit Sub    '   no threshholds
        
            T1 = .Cells(1, 15).Value
            T2 = .Cells(1, 16).Value
            T3 = .Cells(1, 17).Value
            T4 = .Cells(1, 18).Value
        
            CFormula = "=$A" & .Cells(1, 1).Row & "+"
        
            Set r = r.Cells(1, 3).Resize(1, 12)
        End With
    
    
         With r
             .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:=CFormula & T4
             .FormatConditions(.FormatConditions.Count).Interior.Color = vbRed
             .FormatConditions(.FormatConditions.Count).StopIfTrue = True
             
             .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:=CFormula & T3
             .FormatConditions(.FormatConditions.Count).Interior.Color = vbYellow
             .FormatConditions(.FormatConditions.Count).StopIfTrue = True
             
             .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:=CFormula & T2
             .FormatConditions(.FormatConditions.Count).Interior.Color = vbGreen
             .FormatConditions(.FormatConditions.Count).StopIfTrue = True
         
             .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:=CFormula & T1
             .FormatConditions(.FormatConditions.Count).Interior.Color = vbBlue
             .FormatConditions(.FormatConditions.Count).StopIfTrue = True
        End With
    
    
    
    
    End Sub
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  20. #20
    VBAX Tutor
    Joined
    Sep 2012
    Location
    London
    Posts
    264
    Location
    Thank you so much
    i downloaded the file and opened it when i clicked your button with the macro i immediately got the error in the picture i will attach.
    2023-03-16_100157.jpg2023-03-16_100225.jpg

    Sorry, but when I entered the site I saw a purely unintentional omission and I added it and the macro worked.
     If Application.Version > 12 Then
    If Val(Application.Version) > 12 Then


    You are an amazing Man Paul.
    Thank you with all my heart and soul for this help.
    Big bow to you.
    Last edited by k0st4din; 03-16-2023 at 01:29 AM.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •