Need Help With My 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!!

 

[Bob Phillips]

What is StartingDateRange, PreviousShiftStatus?

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[Jenny Marlow]

Oh, Sorry.

I suppose previous shift status is not necessary for this varation of
the function which I am using. You can disregard that.

StartingDateRange is the cell with the first date, and I am offsetting
everything according to it.

In this case, StartingDateRange is in Cell C2, where there is a "1" in
my example, the "1" stands for 4/1/08 displayed with only the day.

Thanks for your inquiry Bob...

Hopefully you can give me some direction with this code that is
stressing me out!

 

[Bob Phillips]

Just looking this, why is the thirds


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

I see it as


UNIT1 RoHS 04/12/2008 04:00, 04/12/2008 20:00

where is the disconnect?


--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[Jenny Marlow]

Oh, I'm sorry, I messed up a bit on my example. Please disregard my
previous post and allow me to attempt to better explain myself.

The R's above indicate operating hours for a production unit. I am
looking for guidance on how to take the above excel data and write a
CSV file that records when the unit is scheduled to be up.

The format would be:

UNIT NAME, PRODUCT, START TIME, END TIME
In this case, R is equal to product ROHS. So for the example above, my
output CSV would be as follows:

UNIT1, ROHS, 04/01/2008 00:00, 04/01/2008 16:00
UNIT1, ROHS, 04/06/2008 00:00, 04/08/2008 00:00
UNIT1, ROHS, 04/12/2008 00:00, 04/12/2008 08:00
UNIT1, ROHS, 04/12/2008 16:00, 04/13/2008 00:00



I think that does a better job of demonstrating what I'm looking for.
Thanks if anyone can help greatly appreciated!

 

[Jenny Marlow]

Here is what I have so far:


Sub ProcessRanges()

'This is the main procedure that processes all turns and writes them
into an output file


On Error GoTo ExitSub
Dim StartingDateRange As Range, FileName As String
Dim FileNumber As Integer
Dim Unit As Integer
Dim PreviousShiftStatus As String
Dim Rowcount As Integer
Dim LastRow As Integer
Dim sht As Integer



Debug.Print ThisWorkbook.Path
FileName = "C:\FCDM.dat"


FileNumber = FreeFile()
Open FileName For Output As #FileNumber


LastRow = Sheet1.Range("C" & Rows.Count).End(xlUp).Row
Rowcount = 0

Do While Rowcount <= LastRow

'Go through the first sheet for each unit, then move on. Explicit
statement of PreviousShiftStatus = "D"
'because it must start on an UP TURN

Set StartingDateRange = Sheet1.Range("C" & (Rowcount + 3))

PreviousShiftStatus = "D"

For sht = 1 To 1

If CreateCVS(Sheets("sheet" & sht), StartingDateRange,
FileNumber, PreviousShiftStatus) Then

'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If


Next sht

Rowcount = Rowcount + 7

Loop


ExitSub:
Close #FileNumber


End Sub




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 "R"
CurrentShiftStatus = "rohs"
Case "", "H"
CurrentShiftStatus = "D"


End Select


If PreviousShiftStatus <> CurrentShiftStatus Then





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




End If

PreviousShiftStatus = CurrentShiftStatus

Next


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

Err_CreateCVS:

End Function

This code above outputs the following:

86,rohs,03/30/2008 00:00
86,D,04/01/2008 16:00
86,rohs,04/04/2008 00:00
86,D,04/06/2008 00:00
86,rohs,04/10/2008 00:00
86,D,04/10/2008 08:00
86,rohs,04/10/2008 16:00
86,D,04/22/2008 08:00
41,,03/30/2008 00:00
41,rohs,04/07/2008 00:00
41,D,04/13/2008 00:00

I just need to figure out a way to stick the date/time of the "D"
line, to the end of the ROHS line, and it will do what I'm looking
for...