identify weekend in VBA 7

[NiteCrawlr]

How can I make a VBA code in Excel that identify weekends in a Date type cell. When it identify a weekend I want it to change the color of the whole line.

Help please,
TKS

Nite

 

[flaniganmj]

Here is something simple to try. It assumes you have a continuous list of dates. If you need something different let me know.

==========================================================

Sub FindWeekends()

On Error Resume Next

Dim myRow As String
'Prevent screen flicker
Application.ScreenUpdating = False
'Define the row you want to start on, MUST be first row to check
myRow = 6
'Cycle through rows where column C has the date
While IsDate(Range("$C$" & myRow))
'Test for Sunday
If Weekday(Range("$C$" & myRow)) = 1 Then
'Select Group of cells to change
Range("$C$" & myRow & ":$E$" & myRow).Select
'Change background color
With Selection.Interior
.ColorIndex = 3 'Red
.Pattern = xlSolid
End With
'Test for Saturday
ElseIf Weekday(Range("$C$" & myRow)) = 7 Then
'Select range
Range("$C$" & myRow & ":$E$" & myRow).Select
'Change background color
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
End If
'Goto next row
myRow = myRow + 1
Wend
End Sub

===========================================================

Let me know if it helps.

flan

 

[DaleWatson123321]

Nite,

Here's a bit of an "assist". It might prove useful in terms of providing more flexibility...

If you decide to give it a try, please advise as to how it "fits".


Sub FindWeekends()
Application.ScreenUpdating = False

'Note: You MUST assign the range name "datecolm" to the
'first cell containing a date in the column used for dates.

'This causes this routine to go to the cell named "datecolm"
' and uses it as the starting point of the routine.

'These variables define the columns you want colored:
startcolm = 1 '= Column A
endcolm = startcolm + 4 '= Column E



Application.Goto Reference:="datecolm"

colm = ActiveCell.Column
dcolm = Range("datecolm&quot.Column

lastrow = Cells(65536, colm).End(xlUp).Offset(1, 0).Address

colm = ActiveCell.Column
dcolm = Range("datecolm&quot.Column


'Prevent screen flicker
'Application.ScreenUpdating = False
myRow = ActiveCell.Row
curcell = Cells(myRow, dcolm).Value
'Cycle through rows that contain a date
'While IsDate(ActiveCell.Value)

While ActiveCell.Row < Range(lastrow).Row

myRow = ActiveCell.Row
curcell = Cells(myRow, dcolm).Value

'Test for Sunday
If WeekDay(curcell) = 1 Then
'Select range of cells to change color
start_addr = Cells(myRow, startcolm).Address
end_addr = Cells(myRow, endcolm).Address
fillrange = start_addr & &quot;:&quot; & end_addr
Range(fillrange).Select


'Change background color - 6 = YELLOW
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With

'Test for Saturday
ElseIf WeekDay(curcell) = 7 Then
'Select range of cells to change color
start_addr = Cells(myRow, startcolm).Address
end_addr = Cells(myRow, endcolm).Address
fillrange = start_addr & &quot;:&quot; & end_addr
Range(fillrange).Select

'Change background color - 6 = YELLOW
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With

End If

'Goto next row

myRow = myRow + 1

ActiveCell.Offset(1, 0).Activate
curcell = Cells(myRow, dcolm).Value

Wend
Application.ScreenUpdating = True
End Sub


Regards, ...Dale Watson dwatson@bsi.gov.mb.ca

 

[xlbo]

Dales - Nice but could be shortened:
Sub FindWeekends()
Application.ScreenUpdating = False

'Note: You MUST assign the range name &quot;datecolm&quot; to the
'first cell containing a date in the column used for dates.

'This causes this routine to go to the cell named &quot;datecolm&quot;
' and uses it as the starting point of the routine.

'These variables define the columns you want colored:
startcolm = 1 '= Column A
endcolm = startcolm + 4 '= Column E

Application.Goto Reference:=&quot;datecolm&quot;

colm = ActiveCell.Column
dcolm = Range(&quot;datecolm&quot.Column

lastrow = Cells(65536, colm).End(xlUp).Offset(1, 0).Address

colm = ActiveCell.Column
dcolm = Range(&quot;datecolm&quot.Column


'Prevent screen flicker
Application.ScreenUpdating = False

While ActiveCell.Row < Range(lastrow).Row

myRow = ActiveCell.Row
curcell = Cells(myRow, dcolm).Value

'Test for Weekend
Select Case WeekDay(curcell)
Case = 1 or 7
'Select range of cells to change color
start_addr = Cells(myRow, startcolm).Address
end_addr = Cells(myRow, endcolm).Address
fillrange = start_addr & &quot;:&quot; & end_addr
'Change background color - 6 = YELLOW
With Range(fillrange)
.interior.colorindex = 6
.pattern = xlsolid
end with

Case Else
End Select


'Goto next row

myRow = myRow + 1

ActiveCell.Offset(1, 0).Activate
curcell = Cells(myRow, dcolm).Value

Wend
Application.ScreenUpdating = True
End Sub
HTH
~Geoff~

 

[beniez]

You could just use conditional formatting. Assuming your dates are in column A, format all rows with the condition &quot;Formula is&quot; and the formala:

=OR(WEEKDAY($A12,2)=6, WEEKDAY($A12,2)=7)

Then set the cell format to whatever you want.

HTH

Ben

 

[xlbo]

Beniez wins - I feel there is definitely a lesson to be learned here. Code should be the last resort, not the 1st
Have a star

HTH
~Geoff~

 

[hjgoldstein]

Can I reverse this post? I need to be able to identify the color of a cell and then change the value of another (empty) cell accordingly. So, if the color of cell A1's contents is red then I need to change the contents of cell M1 to &quot;Floor&quot;.

Is this possible without VB coding?

Any hints welcome.

Thanks.

 

[xlbo]

not without code

Rgds, Geoff
[blue]Quantum materiae materietur marmota monax si marmota monax materiam possit materiari?[/blue]
Want the [red]best[/red] answers to your questions ? faq222-2244

 

[xlbo]

but then that depends on WHY that cell is coloured red. If there is some data that makes it red then you can test for that condition - in which case yes.

Rgds, Geoff
[blue]Quantum materiae materietur marmota monax si marmota monax materiam possit materiari?[/blue]
Want the [red]best[/red] answers to your questions ? faq222-2244

 

[beniez]

hj

When I had to do something similar, I created a user-defined function:

Function CellColor(r As Range) As Integer
'-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
' Returns Color index of first cell of a range
' If return is >1, then cell is coloured
'-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*

Dim sReturn As String

With r.Cells(1, 1).Interior
sReturn = .ColorIndex
End With
CellColor = sReturn
End Function

You can then use conditional formatting in your empty cell to change its colour: the formula would be =cellcolor(B39)>1 - assuming B39 to be the cell whose colour you want to test.

HTH

Ben

 

[Bowers74]

I have another FUnction for you that gives you a bit more flexibility:

Function CellColor(Source As Range) As Integer
Application.Volatile
CellColor = Source.Font.ColorIndex
End Function

Source is the cell you want to check the font color. You can find out the A1's ColorIndex by using the formula =CellColor(A1).

To take it even further (and get where you wanted to go) and change a cell's value based on the font color from another cell.

=IF(cellcolor(A1)=3;"Font is Red";"Font is not Red")
=IF(cellcolor(A2)=6;"Font is Yellow";"Font is not Yellow")
=IF(cellcolor(A4)=10;"Font is Green";"Font is not Green")
=IF(cellcolor(A5)=1;"Font is Black";"Font is not Black")
=IF(cellcolor(A6)=2;"Font is White";"Font is not White")
=IF(cellcolor(A7)=46;"Font is Orange";"Font is not Orange")

Again, if you want to check for another font color, then use =CellColor(SourceCell) and then you can check for it in the IF() formula.

If you want to check for the Background color instead of the font color then change the Source.Font.ColorIndex to Source.Interior.ColorIndex

NOTE: -4142 is the transparent background color for cells in Excel.

I hope this helps!



Peace!

Mike

Never say Never!!!
Nothing is impossible!!!

 

[xlbo]

[cough]
&quot;Is this possible without VB coding?&quot;
[/cough]

Rgds, Geoff
[blue]Quantum materiae materietur marmota monax si marmota monax materiam possit materiari?[/blue]
Want the [red]best[/red] answers to your questions ? faq222-2244

 

[beniez]

Geoff

Yeah well.... I kind of thought my little bit of hacking didn't qualify as VB coding....

No I didn't: I just didn't read the post properly. So you were right and I was wrong, but hey, who's counting? ;-)

 

[xlbo]

not me
I reckon that a little UDF like yours would do the job fine but being as they asked for non vba, htat was the route I was going. Problem is that the little udf isn't much code but it WILL require macros to be enabled for it to work - that may be the issue as much as the user's reluctance to use VBA

Rgds, Geoff
[blue]Quantum materiae materietur marmota monax si marmota monax materiam possit materiari?[/blue]
Want the [red]best[/red] answers to your questions ? faq222-2244

 

[TonyJollans]

Hi Chaps,

A bit of back up for Geoff (not that you need it ).

Neither of the posted bits of code deals with colours set by Conditional Formatting. The conditions, as pointed out by Geoff, could be duplicated without the need for code.

Enjoy,
Tony

 

[Bowers74]

No need to gang up! :-0

I am assuming that Geoff meant, that if Conditonal Formatting was causing the cell to become red then hjgoldstein would only have to check the value of the cell and not the color.

Since hjgoldstein posted that he (she?) wanted to check the font color, I thought of my function and posted it without reading the rest of the posts thoroughly. I guess I was a bit hot headed.

But if hjgoldstein isn't using Conditional Formatting to change the font color then beniez and myself can be awaiting an apology. ;-) (kidding)



Peace!

Mike

Never say Never!!!
Nothing is impossible!!!

 

[TonyJollans]

Hi Mike,

You wanna be in my gang?

I guess we need to know more of the situation. There are several possible combinations. If a cell has red text explicitly set and conditional formatting which changes it to black under particular conditions, .Font.Colorindex will always report it as red. So you need to know that Conditional Formatting neither sets the colour TO red nor FROM red before you can check the Font colour with any certainty.

The reason for considering Conditional Formatting is simply that the question was posted in this thread (where it is given as a solution to the original problem) rather than separately.

I'm sure you know all this, but does the questioner?

Enjoy,
Tony

 

[xlbo]

wow - didn't expect that. My point was purely that NiteCrawlr specifically asked for non vb(a) and I was pointing that out to Mike and beniez - the reason being that it may not be that NiteCrawlr doesn't want to use vba but that it would mean that they would have to make sure that the users enabled macros......guess we need to wait on a reply from NiteCrawlr really to see what the actual situation is.
Now....anyone for ??

Rgds, Geoff
[blue]Quantum materiae materietur marmota monax si marmota monax materiam possit materiari?[/blue]
Want the [red]best[/red] answers to your questions ? faq222-2244

 

[TonyJollans]

.. Tony

 

[Bowers74]

I'm in!!!

.. Mike



Peace!

Mike

Never say Never!!!
Nothing is impossible!!!