• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Need help "stopping" yellow highlighting at the bottom of the data.

Eloise T

Active Member
There are 4 tabs (worksheets) in this workbook.
The last few rows of each worksheet has a white background.

When I run the VBA, I want it to highlight in yellow those last few
rows containing data and then "beep" 3 times to indicate it's done.

It works except it is also coloring 2 blank rows beyond the rows
containing data ...which I don't want.

I've run out of parameters to change. I'm sure it's an easy fix but I just don't see it.

Help please...and Thank you in advance.


The VBA code is here but probably better to see it and run it in the attachment.

Code:
Sub YellowHighlightColumnsAThroughH()
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Formula Info" And ws.Name <> "Dave" Then
            If ws.Cells(Rows.Count, "A").End(xlUp).Row > 2 Then                'Changed 3 to "A" which is the same.
                With ws.[A3:H3].Resize(ws.Cells(Rows.Count, 3).End(xlUp).Row)
'        > > > This VBA yellow-highlights ALL data-filled cells in the array of Columns A3 through H.
'              A3:H3 array tells where to apply change(s).  (Rows.Count, 3) tells in which row to start.
             
                  .Interior.Color = vbYellow  '= RGB(255, 255, 0)
                 
                End With
            End If
        End If
    Next
    '3 BEEPS ---------------------------------------------------------------------------------------
    Beep
'  Pause a second before engaging the next Beep so they don't run together and sound like only one Beep.
'                                  hrs:mi:secs
    Application.Wait Now + TimeValue("0:00:01")
    Beep
'  Pause a second before engaging the next Beep so they don't run together and sound like only one Beep.
    Application.Wait Now + TimeValue("0:00:01")
    Beep
End Sub
 

Attachments

Marc L

Excel Ninja
Just an obvious child level arithmetic error :​
Code:
ws.Range("A3:H" & ws.Cells(Rows.Count, 3).End(xlUp).Row).Interior.Color = vbYellow
Replacing codelines #6 to 12 …
 

Eloise T

Active Member
It just goes to show, when it comes to VBA, I'm not up to the child level yet.
At least I was right about it being an easy fix.
Thanks for the assistance.
 
Last edited:

Marc L

Excel Ninja
Child level logic if last row is #10 as first row is #3 but
your initial code starts from row #3 and resize on 10 rows
so from row #3 to row #12
As the resize should be 10 - 2 so 8 rows 'cause of first row #3 …

My mod starts from row #3 and just ends directly on row #10
without any resize …
 

Eloise T

Active Member
What is the trigger in the code for it to end directly on row 10?

Also, if you don't mind, what if I wanted to put an "IF you find a character string e.g. 'NO IN' in Column H, then don't color that entire row (A thru H)?" The following code didn't quite get it done.

Code:
Sub YellowHighlightColumnsAThroughH()
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Formula Info" And ws.Name <> "Dale" Then
            If ws.Cells(Rows.Count, "A").End(xlUp).Row > 2 Then                'Changed 3 to "A" which is the same.

                If ws.Range("A3:H") <> "NO IN" Then
                    ws.Range("A3:H" & ws.Cells(Rows.Count, 3).End(xlUp).Row).Interior.Color = vbYellow  '= RGB(255, 255, 0)
                 End If
      
            End If
        End If
    Next
End Sub
 
Last edited:

Marc L

Excel Ninja
As per my mod Range("A3:H") & the last row #
aka A3 is the first cell, H last row # the last cell …

Post an attachment with a before worksheet and
an expected result worksheet in order to catch your need.
 

Marc L

Excel Ninja
A beginner way among many :
use a temp column with a formula checking if cell H begins with "NO ".
Filter all range with this column to display only the desired rows
then apply the background color, unfilter, clear temp column, that's it !
Activating the Macro Recorder before operating : you will get a code base.

If you can't succeed, just post an accurate attachment as expected.
As it can be achieved without any code with a conditional formatting …
 

Eloise T

Active Member
Have attachment, but FORGOT to upload attachment. I'M SORRY!!!!!!!!!!!

The attached Workbook contains 3 tabs. Data is added each week to the tabs. The VBA macro "YellowHighlightColumnsAThroughH" when run will highlight the newly added rows of data. However, I do not want the macro to yellow highlight a row where Column H contains, "NO INV" or any extension thereof, e.g. NO IN, NO INV, NO INVOICE, NO INVOICE THIS WEEK, etc.

The CODE below works without the line:
If ws.Range("A3:H") <> "NO IN" Then (with its accompanying End If of course)
but it colors all rows with data including those containing "NO IN"

Please see the attachment and the tab labeled "Paul."
I need help modifying that line: If ws.Range("A3:H") <> "NO IN" Then
so it will not yellow highlight any line A - H containing "NO IN" etc.
Thank you for your assistance in advance.
 

Attachments

Marc L

Excel Ninja
According to your attachment, formatting all tabs :​
Code:
Sub Demo1()
         Dim Ws As Worksheet, Rg(1) As Range
         Application.ScreenUpdating = False
    For Each Ws In Worksheets
             Set Rg(1) = Ws.Cells(Rows.Count, 1).End(xlUp)
        Do Until Rg(1).Interior.Color = vbYellow Or Rg(1).Row < 3
              If Rg(1)(0).Value = "" Or Rg(1)(0).Interior.Color = vbYellow Then
                  Set Rg(0) = Rg(1)
              Else
                  Set Rg(0) = Rg(1).End(xlUp)
                   If Rg(0).Row < 3 Then Set Rg(0) = Ws.[A3]
              End If
           With Range(Rg(0), Rg(1)(1, 8)).Columns
               .Interior.Color = vbYellow
               .Borders.LineStyle = xlContinuous
               .Item("E:F").HorizontalAlignment = xlCenter
               .Item(7).NumberFormat = "m/d/yyyy"
               .Item(8).NumberFormat = """$""#,##0"
           End With
             Set Rg(1) = Rg(0).End(xlUp)
        Loop
    Next
         Erase Rg
         Application.ScreenUpdating = True
End Sub
As the result is instant, is really needed any beep ?
It seems you can delete any conditional formatting …

Do you like it ? So thanks to click on bottom right Like !
 

Eloise T

Active Member
Merci beaucoup. Very impressive VBA code. It works very well on my "TEST..." workbook that I uploaded here on Chandoo, but it dies with Error 400 when I run it with the actual unsanitized workbook.

The beeps were needed as the unsanitized workbook has up to 24 tabs, some have almost 6000 rows, and it currently takes 5 minutes for the VBA macro to run.
The Conditional Formatting is required to highlight large TV models.

I like it but have several questions regarding how the code knows how far to go without the code containing something like:

Code:
If ws.Range("A3:H") <> "NO IN" Then
?

I'll wait to ask more questions so as to not overwhelm you.

I would like to send you the current unsanitized workbook if I may?
 

Marc L

Excel Ninja
It's the common issue when the attachment does not respect
the real workbook layout !

No way to answer about this error without the codeline where it raises …

the code containing something like:
Code:
If ws.Range("A3:H") <> "NO IN" Then
As this code line will raise an error as the range is invalid,
the procedure checks only the first column …

Excel version : 32 or 64 bits ?
 

Eloise T

Active Member
The real workbook is almost 5Mb. Do you have Google drive or some other option as (I'm sure you know) we are limited to 1Mb here on Chandoo?

Excel 2016, 64-bits upload_2018-6-25_14-3-56.png
 

Marc L

Excel Ninja

I do not need all the data but just some respecting exactly
same structure of original worksheets …

Which codeline is yellow highlighted when the error occurs ?
 

Eloise T

Active Member
I whittled down and uploaded the real workbook to under 1Mb but lost 20 of the 24 tabs in the process. I did not forget to upload this time.

ALT-F8 will show 3 macros: CleanUp_8, Demo1, and YellowHighlightColumnsAThroughH.


CleanUp_8 is eight segments that you will see when you look at that macro doing various things like CLEANing and TRIMming, setting font to Calibri 11, setting borders, Horizontal and Vertical alignment, etc.

You know Demo1 since you wrote it.

YellowHighlightColumnsAThroughH macro must be run alone and not part of the CleanUp_8 because it has to be run at a specific time after the other "segments" of CleanUp_8 have run, et. al. ....and no yellow for rows with Column H containing "NO INV..."

The borders segment (EIGHT) of CleanUp_8 needs the same restrictions as the yellow highlighting, i.e. no borders for rows with Column H containing "NO INV..." but needs to be run with the other 7 segments of CleanUp_8.

I hope this explanation is understandable. Please ask if I failed to explain well.

Thanks again for any assistance you can give.
 

Attachments

Marc L

Excel Ninja

My demo was just pasted to a wrong place !
Remove it from Sheet1 module as it must be located in a standard module
or either in ThisWorkbook module (better, where it works on my side) …
And add your worksheet name control like in your original procedure.
 

Marc L

Excel Ninja
The beeps were needed
64 bits Office version can be a mess with VBA
as many stuff can't work in 64 bits …

Replacing the poor VBA Beep well working on 32 bits versions,
try it under your 64 bits version (to paste to the top of a module) :​
Code:
#If Win64 Then
    Private Declare PtrSafe Function kBeep Lib "kernel32" Alias "Beep" (ByVal Frq&, ByVal Dur&) As Boolean
#Else
    Private Declare Function kBeep Lib "kernel32" Alias "Beep" (ByVal Frq&, ByVal Dur&) As Boolean
#End If

Sub DemokBeep()
    FD = [{392,200;494,100;588,200;740,100;880,400;740,100;880,900}]
    For L& = 1 To UBound(FD):  kBeep FD(L, 1), FD(L, 2):  Next
End Sub
You may Like it !
 

Eloise T

Active Member
Like this?:
Code:
#If Win64 Then
    Declare PtrSafe Function kBeep Lib "kernel32" Alias "Beep" (ByVal Frq&, ByVal Dur&) As Boolean
#Else
    Private Declare Function kBeep Lib "kernel32" Alias "Beep" (ByVal Frq&, ByVal Dur&) As Boolean
#End If

Sub DemokBeep()
    FD = [{392,200;494,100;588,200;740,100;880,400;740,100;880,900}]
    For L& = 1 To UBound(FD):  kBeep FD(L, 1), FD(L, 2):  Next
End Sub

Sub Demo1()
          Dim Ws As Worksheet, Rg(1) As Range
          Application.ScreenUpdating = False
    For Each Ws In Worksheets
              Set Rg(1) = Ws.Cells(Rows.Count, 1).End(xlUp)
        Do Until Rg(1).Interior.Color = vbYellow Or Rg(1).Row < 3
              If Rg(1)(0).Value = "" Or Rg(1)(0).Interior.Color = vbYellow Then
                  Set Rg(0) = Rg(1)
              Else
                  Set Rg(0) = Rg(1).End(xlUp)
                    If Rg(0).Row < 3 Then Set Rg(0) = Ws.[A3]
              End If
            With Range(Rg(0), Rg(1)(1, 8)).Columns
                .Interior.Color = vbYellow
                .Borders.LineStyle = xlContinuous
                .Item("E:F").HorizontalAlignment = xlCenter
                .Item(7).NumberFormat = "m/d/yyyy"
                .Item(8).NumberFormat = """$""#,##0"
            End With
              Set Rg(1) = Rg(0).End(xlUp)
        Loop
    Next
          Erase Rg
          Application.ScreenUpdating = True
End Sub
 

Eloise T

Active Member
My demo was just pasted to a wrong place !
Remove it from Sheet1 module as it must be located in a standard module
or either in ThisWorkbook module (better, where it works on my side) …
And add your worksheet name control like in your original procedure.
I read what you said above but I do not understand what you are trying to say.

"My demo..." What wrong place?
"Remove it from Sheet1 module..." What Sheet1 module?
"locate....in ThisWorkbook module" ...ok, but specifically where? It needs to be in CleanUp_8() under "module" EIGHT which is border setting

and

YellowHighlightingColumnsAThroughH()

but I do not know where specifically to insert it...I am working on that now.
 
Last edited:

Marc L

Excel Ninja
For the error just try without Private statement …

Don't you know where you have pasted the code ?!
(When the text cursor blinks in code window, its module is light
grey highlighted in the VBE Project window …)

So just remove Demo1 where it stands and open whatever
a standard module or better ThisWorkbook module
and paste my procedure within.

As the place where any VBA code is located
can change its behaviour from another place …
 

Eloise T

Active Member

"So just remove Demo1 where it stands and open whatever
a standard module or better ThisWorkbook module
and paste my procedure within."

Suggestions? I did what you suggested and got this:


upload_2018-6-26_14-49-46.png

Code appears below as well as in uploaded file.​

Code:
Sub YellowHighlightColumnsAThroughHVERSION2()
    Dim Ws As Worksheet, Rg(1) As Range
    Application.ScreenUpdating = False
    For Each Ws In Worksheets
        If Ws.Name <> "Formula Info" And Ws.Name <> "Dale Purdy" Then
            Set Rg(1) = Ws.Cells(Rows.Count, 1).End(xlUp)
                Do Until Rg(1).Interior.Color = vbYellow Or Rg(1).Row < 3
                    If Rg(1)(0).Value = "" Or Rg(1)(0).Interior.Color = vbYellow Then
                        Set Rg(0) = Rg(1)
                    Else
                        Set Rg(0) = Rg(1).End(xlUp)
                        If Rg(0).Row < 3 Then Set Rg(0) = Ws.[A3]
                    End If
                    With Range(Rg(0), Rg(1)(1, 8)).Columns
                      .Interior.Color = vbYellow
                    End With
                    Set Rg(1) = Rg(0).End(xlUp)
                Loop
        End If
    Next
    Erase Rg
    Application.ScreenUpdating = True

    '3 BEEPS ---------------------------------------------------------------------------------------
    Beep
'  Pause a second before engaging the next Beep so they don't run together and sound like only one Beep.
'                                  hrs:mi:secs
    Application.Wait Now + TimeValue("0:00:01")
    Beep
'  Pause a second before engaging the next Beep so they don't run together and sound like only one Beep.
    Application.Wait Now + TimeValue("0:00:01")
    Beep
End Sub
 

Attachments

Last edited:

Marc L

Excel Ninja
As in your last attachment Demo1 is still in the same wrong place …

Funny little test : delete first the worksheet "Ohio-1"
then return on VBE side : guess where is the code ?‼
Which can't be if code is not located within any worksheet module
but in a standard one or better within Thisworkbook module
like it works on my side !

As a reminder :
When the text cursor blinks in code window,
its module is light grey highlighted in the VBE Project window …

So just remove Demo1 where it stands and open whatever
a standard module or better ThisWorkbook module
and paste my procedure within.
In order to not paste the code in the same worksheet module,
close the code window just after removing Demo1
then open the module of ThisWorkbook …

For kBeep function, both Declare statement must be Private.
 

Eloise T

Active Member
As in your last attachment Demo1 is still in the same wrong place …

I removed Demo1().

Funny little test : delete first the worksheet "Ohio-1"
then return on VBE side : guess where is the code ?‼
Which can't be if code is not located within any worksheet module
but in a standard one or better within Thisworkbook module
like it works on my side !

I deleted worksheet "Ohio-1" and you're right! What happened to the VBA code? I assume you were not expecting that to happen either?

As a reminder :
In order to not paste the code in the same worksheet module,
close the code window just after removing Demo1
then open the module of ThisWorkbook …

For kBeep function, both Declare statement must be Private.
Open above (Click to expand...) to see more of my comments.


You were correct. Private needed, but also PtrSafe on both lines as well.
This is what worked: see boldface
#If Win64 Then
Private Declare PtrSafe Function kBeep Lib "kernel32" Alias "Beep" (ByVal Frq&, ByVal Dur&) As Boolean
#Else
Private Declare PtrSafe Function kBeep Lib "kernel32" Alias "Beep" (ByVal Frq&, ByVal Dur&) As Boolean
#End If

Does it make sense that they are duplicated lines?
 

Attachments

Last edited:

Marc L

Excel Ninja
No as only the first one is for 64 bits so with PtrSafe

Compatibility Between the 32-bit and 64-bit Versions

Try with only the first Declare codeline but if it works,
it works only on 64 bits Office version instead of both versions …


Of course yes it is what I expected for
'cause Demo1 was still within a worksheet module (Sheet1) ‼
As any code won't disappear only if
it is not located in the worksheet to be deleted !

Just read again child level directions I wrote twice …

In this sample on VBE side
Sheet1 is the CodeName of the worksheet "abc" and
as it is grey highlighted so it is its code window which is active …

You just have to open ThisWorkbook module and paste code within
instead of any worsheet module window already opened …

If you see CleanUp_8 procedure in the code window
so you are in the wrong place as this code is
located in the Sheet1 module of worksheet "Ohio-1" ‼
As you can visual check which module is grey highlighted …
 
Top