Help - Loop Function Giving Incorrect Output

[Jenny Marlow]

I need help with this loop that I created, but is giving me the wrong
results...what am I doing wrong?? Any help would be greatly
appreciated!!!


A B C D E F G H I J
1
2
3 Date: 1 2 3 4 5 6 7 8
4 UNIT1 G(00:00) R X X X X R R X
5 D(08:00) R X X X X R R R
6 S(16:00) X X X X X R R X

The R's above indicate operating hours for a production unit. I
created a function that needs 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/08/2008 08:00, 04/08/2008 16:00

But my code is creating an output file of the following:

UNIT1,rohs,04/01/2008 08:00,04/01/2008 16:00
UNIT1,rohs,04/07/2008 16:00,04/08/2008 00:00
UNIT1,rohs,04/08/2008 08:00,04/08/2008 16:00



This is my code:


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, PreviousDate 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 OldShiftItem 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"
PreviousDate = DateValue(CurrentDate)
OldShiftItem = ShiftItem

Case " ", "H", "X", ""
CurrentShiftStatus = "D"


End Select


If PreviousShiftStatus <> CurrentShiftStatus Then


If PreviousShiftStatus = "rohs" Then



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

End If





End If

PreviousShiftStatus = CurrentShiftStatus

Next



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

Err_CreateCVS:

End Function




I could really use some direction as to why this is not working for
me!! Thank you so much for whoever can help me debug this
problem....it would allow me to enjoy my weekend!! Thanks!!

 

[Joel]

I found at least one problem. You were referenceing the sheet wrong in the
two statements
below

LastRow = Sheets("Sheet1").Range("C" & Rows.Count).End(xlUp).Row
Set StartingDateRange = Sheets("Sheet1").Range("C" & (Rowcount + 3))

Your DataValue statement
CurrentDate = DateValue(StartingDateRange)

may also be wrong. StartingDateRange must have an excel date such as
"4/25/08" or any data string that excel recognizes.

 

[Jenny Marlow]

How am I referencing the sheet wrong? The StartingDateRange in the
first instance would be in cell C3. As you can see below, the value in
C3 is "1", which is actually the value "4/1/08" with only the day
showing. So, in this case, the LastRow value would be equal to 7, the
starting date range would be Sheets("Sheet1").Range("C3")...Am I
missing something? The numbers in C3,D3,E3, etc. are all consecutive
date values. 4/1 , 4/2, 4/3, etc....Thank you Joel for your response!

 

[Jenny Marlow]

Dan R. Oakes was very helpful with creating a new function. I was able
to achieve my desired result with the following:

Sub test()
Dim lastCol&, c&, r&, arr(6) As Date
Dim val(15000) As String, dt(2) As String

arr(4) = #12:00:00 AM#
arr(5) = #8:00:00 AM#
arr(6) = #4:00:00 PM#

FileName = "C:\FCDM.dat"
FileNumber = FreeFile()
Open FileName For Output As #FileNumber

With Sheets(1)
i = 1
lastCol = .Cells(4, "IV").End(xlToLeft).Column
val(0) = "null"
For c = 3 To lastCol
For r = 4 To 6
val(i) = UCase(.Cells(r, c).Value)
If val(i) = "R" Then
If val(i - 1) <> "R" Then
dt(1) = Format(.Cells(3, c), "mm/dd/yyyy") & " " &
Format(arr(r), "hh:mm")
End If
End If
If val(i - 1) = "R" And val(i) <> "R" Then
dt(2) = Format(.Cells(3, c), "mm/dd/yyyy") & " " &
Format(arr(r), "hh:mm")
Print #FileNumber, "86" & "," & "ROHS" & "," & dt(1) & ","
& dt(2)
End If
i = i + 1
Next r
Next c
End With

Close
End Sub


Thanks all for your help and input. This is a great community!

 

[Joel]

You had the following
LastRow = Sheet1.Range("C" & Rows.Count).End(xlUp).Row
Set StartingDateRange = Sheet1.Range("C" & (Rowcount + 3))

It should be
LastRow = Sheets("Sheet1").Range("C" & Rows.Count).End(xlUp).Row
Set StartingDateRange = Sheets("Sheet1").Range("C" & (Rowcount + 3))

Sheet one was correct in the subroutine but the function had a differrent
value when the sht was not sheet 1.

with this change the data is
UNIT1,rohs,04/01/2008 08:00,04/01/2008 16:00
UNIT1,rohs,04/07/2008 16:00,04/08/2008 00:00
UNIT1,rohs,04/08/2008 08:00,04/08/2008 16:00

your request was
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/08/2008 08:00, 04/08/2008 16:00