Interesting roster method, need help with start and finish variables.

[Tasemu]

First off i would like to say hello and good day, i am a new member here but hope to become an active contributor. ^^

Ok so here is an issue i am having. My work has given me the roster to edit. The shifts are shown by a purple line made of colored cells which starts at the start of the shift and ends at the end of the shift.

What they want me to do is to fill the two columns labeled Start Time and Finish Time (which i have selected in the pic) dynamically so that if they change the form of the line then the columns would reflect that. I figured the best way to do this was to use if statements to check for the first and last colored cell using VBA because those are the only ones important. but i am getting compiler errors.

Here is what i have got so far.

Function startfin(active As Range)
Dim left, right As Integer
Dim start, fin, currentrow As Integer


left = active.Offset(0, -1)
right = active.Offset(0, 1)
currentrow = active.Row
timecolumn = active.Column + 1

Select Case active.Interior.ColorIndex

Case 2 And left = 1
Cells(currentrow, 3) = timecolumn

Case 2 And right = 1
Cells(currentrow, 4) = timecolumn
End Select

End Function

Any help would be much appreciated.

 

[xld]

Not what sure you are doing, but maybe

Function startfin(active As Range)
Dim left, right As Integer
Dim start, fin, currentrow As Integer

left = active.Offset(0, -1)
right = active.Offset(0, 1)
currentrow = active.Row
timecolumn = active.Column + 1

Select Case True

Case 2
    If left = 1 Then Cells(currentrow, 3) = timecolumn

Case 2
    If right = 1 Then Cells(currentrow, 4) = timecolumn
End Select

End Function

 

[xld]

Not what sure you are doing, but maybe

Function startfin(active As Range)
Dim left, right As Integer
Dim start, fin, currentrow As Integer

left = active.Offset(0, -1)
right = active.Offset(0, 1)
currentrow = active.Row
timecolumn = active.Column + 1

Select Case True

Case 2
    If left = 1 Then
    
        Cells(currentrow, 3) = timecolumn
    ElseIf right = 1 Then
    
        Cells(currentrow, 4) = timecolumn
    End If
End Select
End Function

 

[littleiitin]

Hi,

Welcome to the board.. Even your picture is not visible

However I thing you are passing the active cell as first column range because you used .offset(,-1) which is leading to error i have modified so it will ignore the first column vale for extracting left.

Function startfin(active As Range)
Dim left, right As Integer
Dim start, fin, currentrow As Integer
If active.Column = 1 Then
Else
left = active.Offset(0, -1)
End If
right = active.Offset(0, 1)
currentrow = active.Row
timecolumn = active.Column + 1
Select Case active.Interior.ColorIndex
Case 2 And left = 1
Cells(currentrow, 3) = timecolumn
Case 2 And right = 1
Cells(currentrow, 4) = timecolumn
End Select
End Function

Sub x()
 Call startfin(Range("B1"))
End Sub

 

[Tasemu]

Sorry, i will try to explain better.

The method that the roster uses to show shifts is the purple line.

I need to put a numeric start time and finish time in the two relevant columns.

The two columns need to change automatically when the line is changed.

E.G. The line for Susan on Monday is moved up 2 cells, the columns showing start time and finish time should automatically change to reflect the new times.

Hope this information helps and the code i made might be waaay off but i posted it anyway just incase it helped. ^^

I will also make a direct link for the pic as well.


http://i432.photobucket.com/albums/qq50/tasemu/roster1.jpg

 

[Tasemu]

I tried editing the code a little, i want to put this into every cell along the time line for the shifts, hopefully it will check the active cell and each cell to the left and right. If either of the If Statements are true then it should post the value of the time the dot lines up with to the start or finish column.

Thats the aim of the code anyway. Is there any way to achieve this?

Here is what i have (it doesnt work)

Function startfin()
Dim left, right As Integer
Dim start, fin, currentrow As Integer
If ActiveCell.Column = 1 Then
Else
left = ActiveCell.Offset(0, -1)
End If
right = ActiveCell.Offset(0, 1)
currentrow = ActiveCell.Row
timecolumn = ActiveCell.Column + 1
Select Case ActiveCell.Interior.ColorIndex
Case 2 And left = 1
Cells(currentrow, 3) = timecolumn
Case 2 And right = 1
Cells(currentrow, 4) = timecolumn
End Select
End Function

 

[littleiitin]

Try this:

Sub Roster()
  Dim rngRow As Range
  Dim rngCol As Range
  Dim I As Long
  For Each rngRow In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
    For Each rngCol In Range("E" & rngRow.Row & ":AE" & rngRow.Row)
    
        If rngCol.Interior.ColorIndex = 47 And I = 0 Then
            Range("C" & rngRow.Row) = Cells(1, rngCol.Column).Value
            I = I + 1
        ElseIf rngCol.Interior.ColorIndex = -4142 And I <> 0 Then
            Range("D" & rngRow.Row) = Cells(1, rngCol.Column - 1).Value
            I = 0
            Exit For
        End If
    Next rngCol
  Next
End Sub