Random Highlight only 1 in the each row

Kishan

Well-known Member
Joined
Mar 15, 2011
Messages
1,561
Using Excel 2000</SPAN></SPAN>
Hi,
</SPAN></SPAN>

I need a VBA, which can highlight 1 character out of 1X2 in the each row so far each time 14 total are selected within the 14
</SPAN></SPAN>

Example..

Book1
ABCDEFG
1
2
3
4
5
611X2
721X2
831X2
941X2
1051X2
1161X2
1271X2
1381X2
1491X2
15101X2
16111X2
17121X2
18131X2
19141X2
20
21
22
23
Sheet1


Thank you in advance
</SPAN></SPAN>

Regards,
</SPAN></SPAN>
Kishan
</SPAN></SPAN>
 
Last edited:

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
38,033
Office Version
  1. 2019
  2. 2010
Platform
  1. Windows
Does this macro do what you want...
Code:
Sub RandomHighlight()
  Dim R As Long, LastRow As Long
  Randomize
  LastRow = Cells(Rows.Count, "C").End(xlUp).Row
  Range("C6:E" & LastRow).ClearFormats
  For R = 6 To LastRow
    Cells(R, Int(3 * Rnd + 3)).Interior.Color = 52479
  Next
End Sub
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
15,234
Office Version
  1. 2013
Platform
  1. Windows
Just another way

Code:
Sub Test()
  Dim c As Range
  Range("C6:E19").Interior.ColorIndex = xlNone
  For Each c In Range("C6:C19")
    c.Cells(1).Offset(, WorksheetFunction.RandBetween(0, 2)).Interior.Color = 52479
  Next
End Sub
 

Kishan

Well-known Member
Joined
Mar 15, 2011
Messages
1,561
Does this macro do what you want...
Code:
Sub RandomHighlight()
  Dim R As Long, LastRow As Long
  Randomize
  LastRow = Cells(Rows.Count, "C").End(xlUp).Row
  Range("C6:E" & LastRow).ClearFormats
  For R = 6 To LastRow
    Cells(R, Int(3 * Rnd + 3)).Interior.Color = 52479
  Next
End Sub
Hi Rick, it worked as wanted, just a question I mean to say selection of 1 random out of 3 could you make it bit like machine game have some move left and right before selection after when 1 is selected go for next selection I am not sure I have explained it well.</SPAN></SPAN>

Thank you very much for your help
</SPAN></SPAN>

Kind Regards,
</SPAN></SPAN>
Kishan :)
</SPAN></SPAN>
 

Kishan

Well-known Member
Joined
Mar 15, 2011
Messages
1,561
Just another way

Code:
Sub Test()
  Dim c As Range
  Range("C6:E19").Interior.ColorIndex = xlNone
  For Each c In Range("C6:C19")
    c.Cells(1).Offset(, WorksheetFunction.RandBetween(0, 2)).Interior.Color = 52479
  Next
End Sub
DanteAmor, code stuck at line below I thinks it is not compatible with my version</SPAN></SPAN>
Code:
c.Cells(1).Offset(, WorksheetFunction.RandBetween(0, 2)).Interior.Color = 52479

Thank you for your help</SPAN></SPAN>

Kind Regards,
</SPAN></SPAN>
Kishan
</SPAN></SPAN>
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
15,234
Office Version
  1. 2013
Platform
  1. Windows
It may be the version.
What version of Excel do you use?
 

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
38,033
Office Version
  1. 2019
  2. 2010
Platform
  1. Windows
...could you make it bit like machine game have some move left and right before selection after when 1 is selected go for next selection

I cannot get it to move the colors back and forth in any reasonable time frame, but maybe this will be acceptable to you...
Code:
Sub RandomHighlight()
  Dim R As Long, X As Long, Z As Long, LastRow As Long
  Randomize
  LastRow = Cells(Rows.Count, "C").End(xlUp).Row
  Range("C6:E" & LastRow).ClearFormats
  For R = 6 To LastRow
    Cells(R, "C").Resize(, 3).ClearFormats
    Cells(R, Int(3 * Rnd + 3)).Interior.Color = 52479
    Application.Wait Now + 0.00001
  Next
End Sub
 

Tom.Jones

Active Member
Joined
Sep 20, 2011
Messages
411
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
  2. Mobile
Does this macro do what you want...
Code:
Sub RandomHighlight()
  Dim R As Long, LastRow As Long
  Randomize
  LastRow = Cells(Rows.Count, "C").End(xlUp).Row
  Range("C6:E" & LastRow).ClearFormats
  For R = 6 To LastRow
    Cells(R, Int(3 * Rnd + 3)).Interior.Color = 52479
  Next
End Sub

Hi,

If Range will be B6:Z30, with some empty cells, can you show me how to modify your code.
Need to highlight 5 or 6 cells
Thank you.
 
Last edited:

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
56,479
Office Version
  1. 365
Platform
  1. Windows
.. could you make it bit like machine game have some move left and right before selection after when 1 is selected go for next selection
See if either of these is what you mean. If so, you can experiment with changing the 'Const' lines near the start of each code to get the desired effect.

Rich (BB code):
Sub Rnd_Highlights_1()
  Dim rw As Range, rng As Range
  Dim i As Long, j As Long, colold As Long, colnew As Long
  
  Const CycleStart As Long = 4
  Const CycleSize As Long = 5
  Const Delay As Long = 50000000
  
  Randomize
  Set rng = Range("C6", Range("E" & Rows.Count).End(xlUp))
  rng.Interior.Color = xlNone
  For Each rw In rng.Rows
    For i = 1 To Int(CycleStart + Rnd() * CycleSize)
      colnew = 1 + Int(Rnd() * 3)
      If colnew <> colold Then
        rw.Interior.Color = xlNone
        colold = colnew
      End If
      rw.Cells(colnew).Interior.Color = 52479
      For j = 1 To Delay: Next j
    Next i
  Next rw
End Sub


Rich (BB code):
Sub Rnd_Highlights_2()
  Dim rw As Range, rng As Range
  Dim i As Long, j As Long, k As Long, colnew As Long
  
  Const CycleStart As Long = 3
  Const CycleSize As Long = 4
  Const Delay As Long = 90000000
  
  Randomize
  Set rng = Range("C6", Range("E" & Rows.Count).End(xlUp))
  rng.Interior.Color = xlNone
  For Each rw In rng.Rows
    For i = 1 To Int(CycleStart + Rnd() * CycleSize)
      For k = 1 To 3
        rw.Cells(k).Interior.Color = 52479
        For j = 1 To Delay: Next j
        rw.Interior.Color = xlNone
      Next k
    Next i
    colnew = 1 + Int(Rnd() * 3)
    rw.Cells(colnew).Interior.Color = 52479
  Next rw
End Sub
 

Forum statistics

Threads
1,175,514
Messages
5,897,870
Members
434,684
Latest member
Mochi1

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top