Line Colour

[pauleapo]

In the spreadsheet above, the red line is just a line i have created which i drag around to where it is needed and is not a cell border.

What i am wondering is it possible to make the cell border above for that line to change to red when the date is a monday for every week, i know i could do this with conditional format, but there can be multiple date which equals monday each week and i only want the top 1 to be red. hope this all makes sense

Regards
Paul

 

[sunnyland]

SORRY I POSTED THIS BUT AFTER FURTHER TESTING THIS IS NOT WORKING AS SUPPOSED AS I HAD THE RED LINE IT WAS MOVING FINE WHEN SORTING BUT IF NO LINE DOESN'T GENERATE THE LINES....
Don't have time to look at it anyfurther today, will check back on it tomorrow.

Sorry once again

========================================
Hie again,

I have been as always too fast to answer.

Yes this can be put on the change event

If your column F of dates are sorted this should work [meaning the first one will have the red on top]

Think a minute about it: If you have several cell with let's say with Monday 24 October 2006
How are you going to tell wich is the first one if they are identical.

The point is trying to put the line of the first one will work when you sort but depending on which field you sort by the red line will not be on the correct date

The question about not using a Monday as the first day of the week do you mean your week starts on another day or your weekly data may be starting on a different day every week.

Here modified code that involves the first Monday for each week with red line from A to AL

If your week is not starting on a Monday changing line [changing the 1 to 2 if Tuesday,3 if Wednesday should do the trick.
If Weekday(rowi, vbMonday) = 1

Sub PutARedLineAboveMonday()
'replace sheet1 by the codename of your sheet
Dim rowi As Range
For Each rowi In Sheet1.Columns(6).Cells
If VarType(rowi) = vbDate Then
If Weekday(rowi, vbMonday) = 1 And WorksheetFunction.CountIf(Range("f1:f" & rowi.Row - 1), rowi) = 0 Then
entirerowredtop Range("a" & rowi.Row & ":AL" & rowi.Row), 3, True
Else
entirerowredtop Range("a" & rowi.Row & ":AL" & rowi.Row), 1, False
End If
End If
Next
End Sub

Sub entirerowredtop(rowi As Range, colorchosen As Integer, thickline As Boolean)
With rowi
.Borders(xlEdgeTop).LineStyle = xlContinuous
If thickline = True Then
.Borders(xlEdgeTop).Weight = xlThick
Else
.Borders(xlEdgeTop).Weight = xlThin
End If

.Borders(xlEdgeTop).ColorIndex = colorchosen
End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Me.PutARedLineAboveMonday
End Sub

See how it works this time, not yet perfect but improving

 

[pauleapo]

Hi,
Thanx again.

As soon as i enter data into any cell i get an error on the line

Me.PutARedLineAboveMonday

Just to check i put the code in the right sections please check this.

I put the code below in the worksheet code

Private Sub Worksheet_Change(ByVal Target As Range) 
Me.PutARedLineAboveMonday 
End Sub

and put this code below in a module

Sub PutARedLineAboveMonday() 
'replace sheet1 by the codename of your sheet 
Dim rowi As Range 
For Each rowi In Sheet1.Columns(6).Cells 
If VarType(rowi) = vbDate Then 
If Weekday(rowi, vbMonday) = 1 And WorksheetFunction.CountIf(Range("f1:f" & rowi.Row - 1), rowi) = 0 Then 
entirerowredtop Range("a" & rowi.Row & ":AL" & rowi.Row), 3, True 
Else 
entirerowredtop Range("a" & rowi.Row & ":AL" & rowi.Row), 1, False 
End If 
End If 
Next 
End Sub 

Sub entirerowredtop(rowi As Range, colorchosen As Integer, thickline As Boolean) 
With rowi 
.Borders(xlEdgeTop).LineStyle = xlContinuous 
If thickline = True Then 
.Borders(xlEdgeTop).Weight = xlThick 
Else 
.Borders(xlEdgeTop).Weight = xlThin 
End If 

.Borders(xlEdgeTop).ColorIndex = colorchosen 
End With 
End Sub

So i donot know if i have done something wrong?

Cheers
Paul

 

[sunnyland]

Hello Paul,

Sorry I think my solution fail, I had the red line from previous code and after further testing this is a flop as sorting data doesn't raise an event.

I think you should stick to the conditional formatting using a combination of an index and the weeknumber via the excel function provided in the analysis toolpack.

I posted a sample on the same site as you posted the picture of your workbook:

http://www.zshare.net/download/redline2-xls.html

Sorry if this is all a bit of a disappointment to you, I will have to refrain to answer too quickly.

But I guess your request is more a practical need than an essential need, so I hope may be someone out there reading your and my post will be able to help you a little bit more.

I feel bad to have given you hope of a solution via VBA. See if you can work with the conditional formatting instead.

 

[pauleapo]

Dont feel bad

thanks for all your help