Need Help With Loop That Creates Output File

[Jenny Marlow]

Hello,

I'm stuck on this function that goes through a range and writes a .dat
file to create a production schedule. I don't know if I need to re-do
my function or not, because I can't think of a way to make this work!!
Any help would be appreciated!! I have the following set up:



A B C D E F G H I J K L M N O
1 2 3 4 5 6 7 8 91011 12 1314
UNIT1 G X X X X X R R X X X X R X X
D X X X X X R R X X X X X X X
S X X X X X R R X X X X R X X


I have a function that goes through the range and looks for an
instance of "R", and then outputs the data into a .dat file. The first
row indicates a date, and column B indicates what the shift is. G is
equal to 04:00, D is equal to 12:00, and S is equal to 08:00. Any time
it comes across an "R", it records it as "ROHS".

I have the following function that I pasted below, which takes the
range above and records R shift lengths into a .dat file. My output
for the following function is the following:

UNIT1 RoHS 04/6/2008 04:00
UNIT1 RoHS 04/6/2008 00:00
UNIT1 RoHS 04/6/2008 20:00
UNIT1 RoHS 04/7/2008 04:00
UNIT1 RoHS 04/7/2008 00:00
UNIT1 RoHS 04/7/2008 20:00
UNIT1 RoHS 04/12/2008 04:00
UNIT1 RoHS 04/12/2008 20:00

This is great, except I only need the entire shifts duration, and not
each instance of R. How can I set up a loop that records the start and
end date of the R shift in the same line? I am looking for a function
that would instead have an output like this:

UNIT1 RoHS 04/6/2008 04:00, 04/07/2008 20:00
UNIT1 RoHS 04/12/2008 00:00, 04/12/2008 04:00
UNIT1 RoHS 04/12/2008 20:00, 04/13/2008 00:00




Private Function CreateCVS( _
sh As Worksheet, _
StartingDateRange As Range, _
FileNumber As Integer, _
PreviousShiftStatus As String) As Boolean


On Error GoTo Err_CreateCVS
Dim UnitNumber As String, CurrentDate As Date
Dim DataRange As Range


Dim FirstColumn As Integer, LastColumn As Integer, _
CurrentColumn As Integer


Dim ShiftRow As Long, ShiftStatus(1 To 3) As String
Dim ShiftItem As Integer
Dim CurrentShiftStatus As String
Dim ConservationShutdown As Boolean
Dim HalfDay As Boolean


Dim i As Integer


'Data Range starts with first schedule box. Everything else is
'offset according to this cell


Set DataRange = sh.Range(StartingDateRange.Offset(1), _
StartingDateRange.End(xlToRight).Offset(3))


Debug.Print DataRange(1).Address


FirstColumn = DataRange(1).Column
LastColumn = FirstColumn + DataRange.Columns.Count - 1
ShiftRow = DataRange(1).Row
UnitNumber = DataRange(1).Offset(, -2)
CurrentDate = DateValue(StartingDateRange)

If UnitNumber <> "0" Then

For CurrentColumn = FirstColumn To LastColumn

ShiftStatus(1) = sh.Cells(ShiftRow, CurrentColumn)
ShiftStatus(2) = sh.Cells(ShiftRow + 1, CurrentColumn)
ShiftStatus(3) = sh.Cells(ShiftRow + 2, CurrentColumn)


For ShiftItem = 1 To 3



Select Case Trim(UCase(ShiftStatus(ShiftItem)))
Case "X", "O"
CurrentShiftStatus = "D"


Case "R"
CurrentShiftStatus = "U"
Print #FileNumber, UnitNumber
& " RoHS " & _
Format(CurrentDate +
Choose(ShiftItem, #4:00:00 AM#, #12:00:00 AM#, #8:00:00 PM#), _
"mm/dd/yyyy hh:mm")







End Select


PreviousShiftStatus = CurrentShiftStatus

Next


CurrentDate = CurrentDate + 1
Next
CreateCVS = True
Exit Function
End If

Err_CreateCVS:

End Function



Is this possible??? Any help or pointers would be greatly
appreciated!!