Question

Conditional Flashing Cells in XL2K

Asked by: TigerMan

Hi All,

Small problem - for Trivia Night XL tool - on the big screen - need some glitz [not my forte!].

Have 15 teams and they present nicely in a 'View' sheet for overhead projection.  Round 1 through to Round 10 - total on right hand side [Col W].  Two sheets 1: Data - for entering results and playing wild cards to increment scores by pre-set factor, and 2: View with the nice clean overhead results page.

In 'View', need the cells of the row of the current winner to flash light green, runner up flashes light blue, and third to flash yellow.

Each of these rows must flash conditionally dependent on ranking in field of teams.

Something like macro that runs on either counter, timer, or stepped loop.   Whenever the View sheet has focus, run macro - enable breaking out of the macro [as it will run in full screen, maybe a button with Ctrl-? to break out of the loop] to return to the Data Sheet.

Ask me some more questions if there is insufficient to get an idea of what I am doing, or grab a copy of the work in progress from www.liveit.com.au/filetfr [best to Save Copy As].

In all fairness, I think it best to post the code for the solution in EE - so don't bother to try to send the file back to me.

Also, I would think there might be a few have a go, so would be happy to up the points and split if needed.

Have fun - back in about 8 hours.

Dave

This Question has been solved and asker verified All Experts Exchange premium technology solutions are available to subscription members.

Subscribe now for full access to Experts Exchange and get

Instant Access to this Solution

  • Plus...
  • 30 Day FREE access, no risk, no obligation
  • Collaborate with the world's top tech experts
  • Unlimited access to our exclusive solution database
  • Never be left without tech help again

Subscribe Now

Asked On
2002-03-16 at 07:15:37ID20277678
Topic

Microsoft Office Suite

Participating Experts
2
Points
150
Comments
13

Trusted by hundreds of thousands everyday for fast, accurate and reliable tech support.

  • "The time we save is the biggest benefit of Experts Exchange to Warner Bros. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange." Mike Kapnisakis, Warner Bros.
  • "Our team likes having a resource that is more secure than just using Google and most experts using this service really know their stuff. It's nice to look here first versus using Google." Dayna Sellner, Lockheed Martin
  • "Anytime that I've been stumped with a problem, 9 out of 10 times Experts Exchange has either the accepted solution or an open discussion of the potential solution to the problem." Kenny Red, eBay Inc.

See what Experts Exchange can do for you.

Got a question?

We've got the answer.

Experts Exchange has been collecting answers to technology questions since 1996…3 million and counting! If you have a question, chances are we already have your answer.

Screenshot of Experts Exchange Knowledgebase

Need individual assistance?

Our experts are ready to help.

If you can't find the exact answer you're looking for, ask our exclusive community of 50,000 experts. You’ll get a personalized answer from a trusted professional.

Screenshot of Experts Exchange Knowledgebase

Want to learn from the best?

Read articles from industry experts.

Thousands of free tech tips, tricks, how-to’s and tutorials are available in our peer reviewed articles section. See for yourself how smart our experts are, no login required.

Screenshot of an Article

Working on a long term project?

Store your work and research.

Save solutions to your questions, answers you’ve discovered through searching plus helpful articles in your personal knowledgebase for easy future access.

Screenshot of Experts Exchange Knowledgebase

Access the answers to your technology questions today.

Subscribe Now

30-day free trial. Register in 60 seconds.

What Makes Experts Exchange Unique?

Members of the expert community talk about why the experience at Experts Exchange is different than what you will find anywhere else.

Trusted by the world's most respected brands.

image of each brand's logo

Faithfully serving IT professionals since 1996.

Experts Exchange Logo

Try it out and discover for yourself.

Subscribe Now

30-day free trial. Register in 60 seconds.

Related Solutions

  1. Excel Cell Editing Macro
    1st Thanks..trying to edit with a macro, a cell contaning both numbers and letter. example.. n2348790 on node WDC01. trying to remove the "on node WDC01" and leave the 1st part #'s. Then I will loop this to goto the next cell and do it again.
  2. Swap cells in excel macro
    I could really use a piece of macro/VB script to quickly be able to prioritize values in a column. Unfortunately I'm a noob to VB programming, so I'm hoping you can help. The macro I have in mind would check if the cell above is not empty and if not so, swap the value of the...
  3. Macro- Take the comment from a cell and paste it into the c…
    I have a column of 10 cells, each one having a comment. I select the column of 10 cells and type Ctrl-Y to execute my macro. The macro takes the comment of each cell and copies it into the cell on the right. Could you help me, please?
  4. Creating a macro to edit cells
    I would like to create a very simple macro to do the following: start in the active cell edit that cell, i.e. simulate pressing F2 or double clicking the cell simulate pressing enter to stop editing the cell move to the cell below and repeat for an undefined number of rows (...
  5. EXCEL: SORTING AND RANKING CELLS
    Excel: A B C D E F G H I J K L M N O P 1 STATE ABCD EFGH IJKL MNOP QRST 1st 2nd 3rd 4th 5th 6th 7th ...
  6. RANK and blank cells
    Hi, I have a sportsday spreadsheet that ranks races/events. It works ok, but it's flawed...so not ok! I have seven competitors possible and the winner gets 7 pts and then the rest is awarded points for 2nd = 6pts etc down to one, so everyone will get a point basically. The...

Free Tech Articles

  1. WARNING: 5 Reasons why you should NEVER fix a computer for free.
    It is in our nature to love the puzzle. We are obsessed. The lot of us. We love puzzles. We love the challenge. We thrive on finding the answer. We hate disarray. It bothers us deep in our soul. W...
  2. SCCM OSD Basic troubleshooting
    SCCM 2007 OSD is a fantastic way to deploy operating systems, however, like most things SCCM issues can sometimes be difficult to resolve due to the sheer volume of logs to sift through and the dispe...
  3. Migrate Small Business Server 2003 to Exchange 2010 and Windows 2008 R2
    This guide is intended to provide step by step instructions on how to migrate from Small Business Server 2003 to Windows 2008 R2 with Exchange 2010. For this migration to work you will need the fo...
  4. Create a Win7 Gadget
    This article shows you how to create a simple "Gadget" -- a sort of mini-application supported by Windows 7 and Vista. Gadgets can be dropped anywhere on the desktop to provide instant information, ...
  5. Outlook continually prompting for username and password
    There have been a lot of questions recently regarding Outlook prompting for a username and password whilst using Exchange 2007. There are a few reasons why this would happen and I will try to cover t...
  6. Backup Exchange 2010 Information Store using Windows Backup
    There seems to be quite a lot of confusion around the ability to backup Exchange 2010 using the built in Windows Backup feature. This stems from the omission of this feature prior to Exchange 2007 s...

Cloud Class Webinars

  1. Avoiding Bugs in Microsoft Access
    Alison Balter takes and in-depth look at avoiding bugs in Access. In this webinar you will learn about using the immediate window to debug your applications, invoking the debugger, using breakpoints to troubleshoot, stepping through code, setting the next statement to execute, ...
  2. Top 10 Best New Features in Visio 2010
    Scott Helmers gives live demonstrations of the top 10 new features in Visio 2010. This webinar will teach you how to create compelling diagrams by adding shapes to the page with a single click, linking the shapes in a diagram to data in Excel (or SQL Server, or SharePoint), ...
  3. IT Consultant Business Secrets Revealed
    Michael Munger, Experts Exchange tech pro and IT consultant, pulls back the curtain on his very successful businesses and answers question on every IT consultant and business owner should know about. He shares secrets on what he did to solve the 5 most common problems in IT, ...
  4. Disaster Recovery and Business Continuity
    Quest CTO, Mike Billon, gives an overview of the steps involved in building a dunamic disaster recovery plan. Through case studies and an examination of software/hardware tooles for monitoring and testing, you'll gain a better understandin of where you are, where you want ...
  5. Organize Your Visio Diagrams with Containers and Lists
    Scott Helmers uses cross functional flowcharts, wireframe diagrams, data graphic legends and seating charts to teach you: how to ustilize all three new structured diagram components in Visio 2010, the best practices for organizeing shapes in previous version of Visio, how to organize ...
  6. How to Us Objects, Properties, Events and Methods in Microsoft Access
    Alison Dalter gives an in-depbth look at objects, properties, events and methods in Microsoft Access. In this webinar you will learn about using the object browser, referring to objects, working with properties and methods, working with object variables, understanding the ...

Join the Community

Give a Little. Get a Lot.

Join the community of experts here and help other tech pros by answering question in your area of expertise. You can earn FREE access to all Experts Exchange's premium features and resources.

Join the Community

Answers

 

by: calacucciaPosted on 2002-03-16 at 10:00:34ID: 6871546

Dave,

I will assume that the range containing the totals are always on the same location, in your sample W3:W17

Try the following code in the worksheet module of the View sheet, and look if you're happy with this.

Kind Regards
calacuccia

'****** Code *********

Dim stopFlag As Boolean


Private Sub Worksheet_Activate()
stopFlag = False
goFlashing
End Sub


Private Sub Worksheet_Deactivate()
stopFlag = True
stopFlashing
End Sub

Sub goFlashing()
Dim totals As Range, c As Range
Dim actTotal As Double
Dim firstRow As Integer, i As Integer
Dim aRank As Integer, nEquals As Integer
Dim zFirst(), zSecond(), zThird() As Integer
Dim Range1 As Range, Range2 As Range, Range3 As Range
Set totals = Me.Range("W3:W17") 'You know this can be changer, fixed for the moment
'Look for first place teams (put them in matrix zFirst)
aRank = 1
actTotal = Application.WorksheetFunction.Large(totals, aRank)
Set c = totals.Find(What:=actTotal, LookIn:=xlValues, Lookat:=xlWhole)
firstRow = c.Row
ReDim Preserve zFirst(0)
zFirst(0) = 0
Do
    ReDim Preserve zFirst(UBound(zFirst) + 1)
    zFirst(UBound(zFirst)) = c.Row
    Set c = totals.FindNext(c)
Loop While Not c Is Nothing And c.Row <> firstRow
Set Range1 = Me.Range("B" & zFirst(1) & ":W" & zFirst(1))
For i = 2 To UBound(zFirst)
    Set Range1 = Union(Range1, Me.Range("B" & zFirst(i) & ":W" & zFirst(i)))
Next i
'Look for second place teams (put them in matrix zSecond)
aRank = aRank + UBound(zFirst)
actTotal = Application.WorksheetFunction.Large(totals, aRank)
Set c = totals.Find(What:=actTotal, LookIn:=xlValues, Lookat:=xlWhole)
firstRow = c.Row
ReDim Preserve zSecond(0)
zSecond(0) = 0
Do
    ReDim Preserve zSecond(UBound(zSecond) + 1)
    zSecond(UBound(zSecond)) = c.Row
    Set c = totals.FindNext(c)
Loop While Not c Is Nothing And c.Row <> firstRow
Set Range2 = Me.Range("B" & zSecond(1) & ":W" & zSecond(1))
For i = 2 To UBound(zSecond)
    Set Range2 = Union(Range2, Me.Range("B" & zSecond(i) & ":W" & zSecond(i)))
Next i
'Look for second place teams (put them in matrix zSecond)
aRank = aRank + UBound(zSecond)
actTotal = Application.WorksheetFunction.Large(totals, aRank)
Set c = totals.Find(What:=actTotal, LookIn:=xlValues, Lookat:=xlWhole)
firstRow = c.Row
ReDim Preserve zThird(0)
zThird(0) = 0
Do
    ReDim Preserve zThird(UBound(zThird) + 1)
    zThird(UBound(zThird)) = c.Row
    Set c = totals.FindNext(c)
Loop While Not c Is Nothing And c.Row <> firstRow
Set Range3 = Me.Range("B" & zThird(1) & ":W" & zThird(1))
For i = 2 To UBound(zThird)
    Set Range3 = Union(Range3, Me.Range("B" & zThird(i) & ":W" & zThird(i)))
Next i
'Now make rows stored in zFirst flash
Range1.Interior.ColorIndex = 34
'Same to rows from zSecond
Range2.Interior.ColorIndex = 35
'and for rows in zThird
Range3.Interior.ColorIndex = 36
If stopFlag = False Then
    Application.OnTime Now() + TimeValue("00:00:02"), "The_Game.xls!Sheet2.BackWhite"
End If
End Sub

Sub stopFlashing()
Me.Range("B3:W17").Interior.ColorIndex = -4142
End Sub

Sub BackWhite()
stopFlashing
If stopFlag = False Then
    Application.OnTime Now() + TimeValue("00:00:02"), "The_Game.xls!Sheet2.goFlashing"
End If
End Sub

 

by: TigerManPosted on 2002-03-16 at 17:23:35ID: 6872770

hi Cal,

Good to see you back [for a while].

As usual, the tricky ones fall to you - are you happy with 100 or was there more work than this?

You name your price and I will oblige.

Dave

 

by: TigerManPosted on 2002-03-16 at 18:21:24ID: 6872997

Cal,

Just one little problem.

If attempting to close the workbook with the 'flashing' View sheet open, XL sees the change made by the flash, saves, and re-opens.  The workaround is to close from any other worksheet, but ... can you make so it closes from View sheet?

A new copy of the work in progress is at www.liveit.com.au/filetfr

Dave

 

by: TigerManPosted on 2002-03-16 at 23:25:59ID: 6873563

And the little things that matter ....

When there is no data in the Data Entry sheet i.e. all scores set back to "", the View sheet fails because the macro is looking for values that don't exist.

A little mod to this one?

Dave

 

by: TigerManPosted on 2002-03-16 at 23:27:07ID: 6873567

Cal,

Even if you use 0s in Round 1, this problem occurs - but maybe because the macro has trouble with all scores the same?

Dave

 

by: calacucciaPosted on 2002-03-17 at 10:06:44ID: 6874384

Dave,

I will take my second trial now ;-)

See ya soon.

 

by: calacucciaPosted on 2002-03-17 at 14:04:35ID: 6875006

Well,

The first problem was to call an OnTime at the exact same moment (as explained in this article), which is why I used a workaround, which made the workbook be re-opened when it was closed, while a OnTime event was still scheduled. The correction is included in the code. But you will need to add the line Sheet1.Activate to the before_close event of your workbook:


Private Sub Workbook_BeforeClose(Cancel As Boolean)
Sheet1.Activate
End Sub

The second problem, is because in case of empy scores, all teams are in first place, and the search for 2nd and 3rd place is causing errors. The same of course, as you noticed yourself, applies to 15 equal scores. This is now dealed with by error handlers.

Code follows (the result sheet part)

calacuccia

'Code

Dim nextTime As Double


Private Sub Worksheet_Activate()
goFlashing
End Sub


Private Sub Worksheet_Deactivate()
On Error Resume Next
'Error loop necessary, because it is unknown which of both procedures is
'scheduled at this point, so the error caused by 1 of 2 statements below is
'expected and normal
Application.OnTime nextTime, "The_Game.xls!Sheet2.BackWhite", , False
Application.OnTime nextTime, "The_Game.xls!Sheet2.goFlashing", , False
On Error GoTo 0
stopFlashing
End Sub

Sub goFlashing()
Dim totals As Range, c As Range
Dim actTotal As Double
Dim firstRow As Integer, i As Integer
Dim aRank As Integer, nEquals As Integer
Dim zFirst(), zSecond(), zThird() As Integer
Dim Range1 As Range, Range2 As Range, Range3 As Range
Set totals = Me.Range("W3:W17") 'You know this can be changer, fixed for the moment
'Look for first place teams (put them in matrix zFirst)
aRank = 1
'Error loop to deal with all empty data ""
On Error Resume Next
actTotal = Application.WorksheetFunction.Large(totals, aRank)
If Err.Number = 1004 Then Exit Sub
Err.Clear
On Error GoTo 0
Set c = totals.Find(What:=actTotal, LookIn:=xlValues, Lookat:=xlWhole)
firstRow = c.Row
ReDim Preserve zFirst(0)
zFirst(0) = 0
Do
   ReDim Preserve zFirst(UBound(zFirst) + 1)
   zFirst(UBound(zFirst)) = c.Row
   Set c = totals.FindNext(c)
Loop While Not c Is Nothing And c.Row <> firstRow
Set Range1 = Me.Range("B" & zFirst(1) & ":W" & zFirst(1))
For i = 2 To UBound(zFirst)
   Set Range1 = Union(Range1, Me.Range("B" & zFirst(i) & ":W" & zFirst(i)))
Next i
'Look for second place teams (put them in matrix zSecond)
aRank = aRank + UBound(zFirst)
'Error handler used to detect cases with only no. 1 position teams
On Error Resume Next
actTotal = Application.WorksheetFunction.Large(totals, aRank)
If Err.Number = 1004 Then
    Err.Clear
    On Error GoTo 0
    GoTo flashPart
End If
On Error GoTo 0
Set c = totals.Find(What:=actTotal, LookIn:=xlValues, Lookat:=xlWhole)
firstRow = c.Row
ReDim Preserve zSecond(0)
zSecond(0) = 0
Do
   ReDim Preserve zSecond(UBound(zSecond) + 1)
   zSecond(UBound(zSecond)) = c.Row
   Set c = totals.FindNext(c)
Loop While Not c Is Nothing And c.Row <> firstRow
Set Range2 = Me.Range("B" & zSecond(1) & ":W" & zSecond(1))
For i = 2 To UBound(zSecond)
   Set Range2 = Union(Range2, Me.Range("B" & zSecond(i) & ":W" & zSecond(i)))
Next i
'Look for third place teams (put them in matrix zThird)
aRank = aRank + UBound(zSecond)
'Error handler used to detect cases with only no. 1 position teams
On Error Resume Next
actTotal = Application.WorksheetFunction.Large(totals, aRank)
If Err.Number = 1004 Then
    Err.Clear
    On Error GoTo 0
    GoTo flashPart
End If
On Error GoTo 0
Set c = totals.Find(What:=actTotal, LookIn:=xlValues, Lookat:=xlWhole)
firstRow = c.Row
ReDim Preserve zThird(0)
zThird(0) = 0
Do
   ReDim Preserve zThird(UBound(zThird) + 1)
   zThird(UBound(zThird)) = c.Row
   Set c = totals.FindNext(c)
Loop While Not c Is Nothing And c.Row <> firstRow
Set Range3 = Me.Range("B" & zThird(1) & ":W" & zThird(1))
For i = 2 To UBound(zThird)
   Set Range3 = Union(Range3, Me.Range("B" & zThird(i) & ":W" & zThird(i)))
Next i
'Now make rows stored in zFirst flash
flashPart:
Range1.Interior.ColorIndex = 34
'Same to rows from zSecond
On Error Resume Next
'This part is also handled, to prevent the case of all no. 1 position teams
Range2.Interior.ColorIndex = 35
'and for rows in zThird
Range3.Interior.ColorIndex = 36
Err.Clear
On Error GoTo 0
nextTime = Now() + TimeValue("00:00:01")
Application.OnTime nextTime, "The_Game.xls!Sheet2.BackWhite"
End Sub

Sub stopFlashing()
Me.Range("B3:W17").Interior.ColorIndex = -4142
End Sub

Sub BackWhite()
stopFlashing
nextTime = Now() + TimeValue("00:00:01")
Application.OnTime nextTime, "The_Game.xls!Sheet2.goFlashing"
End Sub

 

by: calacucciaPosted on 2002-03-17 at 14:04:58ID: 6875008

 

by: TigerManPosted on 2002-03-20 at 15:51:52ID: 6884217

Thanks cal - tested OK.  Problems gone - able to modify relatively easily to create different behaviour.

How many points do you want? i.e. make it worth your time.

Dave

 

by: bruintjePosted on 2002-03-20 at 15:55:44ID: 6884224

;) why are we all willing to see cal sneak in on Ture again? it seems a bit of a Greek drama

 

by: calacucciaPosted on 2002-03-21 at 01:26:03ID: 6884995

Dave, ThAnks (that's for the A in advance ;-))

Points is not my major concern, although sneaking up on Ture is right now one of my drivers... but I was glad to help you for 0.1K points here, Dave.

Cheers
calacuccia

 

by: TigerManPosted on 2002-03-22 at 22:32:41ID: 6890484

OK, so as I recognise that more than a little effort was required, I'll chuck you another 50.

I will Accept and close when I have finished tidying up the workbook - and will then make it available again - just so you can see finished product.

Dave

 

by: TigerManPosted on 2002-03-28 at 18:00:44ID: 6904120

cal, no time to further develop, thus cannot put on web for you to grab.

But got to close question so thanks!

Dave

20120131-EE-VQP-002

3 Ways to Join

30-Day Free Trial

The Experts

98% positive feedback on 31,087 answers since March 2000. angeliii is a Microsoft Most Valuable Professional for his work with MS SQL Server & Develoment.

He has also proven his knowledge of Visual Basic Programming, PHP Scripting and Oracle Databases.

The Experts

97% positive feedback on 10,752 answers since July 2000. lrmoore has more than 18 years experience in the networking industry.

The six-time Mircosoft MVPs specialties include firewalls, virtual private networking, and network management.

Testimonials

"...and excellent source for support... Kind of like having your very own IT dept." Electriciansnet

Testimonials

"I was apprehensive at signing up at first. However... it has already made my life as an IT administrator much easier." JaCrews

Testimonials

"WOW! You guys have great, active, and knowledgeable people on here." moore50

Business Clients

Business Clients

In the Press

"If you’ve got a question... Experts Exchange can supply an answer.”

In the Press

"...an invaluable aid for both IT professionals and those who require tech support."

In the Press

"where IT professionals provide quick answers on just about any topic"

Business Account Plans

Loading Advertisement...