ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Change sheets within a read and write function... (https://www.excelbanter.com/excel-programming/403848-change-sheets-within-read-write-function.html)

Naji

Change sheets within a read and write function...
 
Hello,

I am given the task of expanding an already existing macro, however
I'm a bit novice I suppose and I am stuck with the program not working
with the added changes, so I'm doing it wrong. I have simplified the
code and functionality to better enable me to explain my problem and
hopefully get some helpful feedback that won't confuse the reader.

The macro's purpose is to read production turns for a unit and write
them out into a comma delimited file to be used by production
programs. It goes through a 3-row multiple column range where each row
indicates a shift(morning/mid/night) and each column indicates a date.
The macro's purpose is to detect changes from " " to "X" or from "X"
to " " to indicate time frames when the machine is running as to when
it's "down" and not. Once it goes through this range, it moves on to
the next unit which has its turns listed below it, and so on. These
planned up and down instructions are then fed into the machines
themselves to instruct when they are on or off.

Anyhow, currently the macro and spreadsheet is one single spreadsheet.
I need to expand the workbook to 3 spreadsheets to extend the time
frame further. So for each unit, after it's done with the first
worksheet, it moves on to the second worksheet which is just a
continuation of the first worksheet and basically a twin, with only
the dates and turns different, and then a third.

I just put in a change sheet command and copied and pasted the code
three times to fufill the effect but it is not moving on to the second
and third pages. The dates change forward accordingly, but it just
copies the turns from the first spreadsheet twice instead of reading
in from the second and then third. Please, I know this is a simple
solution to a program that already exists...it's just I'm no expert
and don't want to start this all over just because I don't understand
the existing logic. Your help will make my day! I spent all day
yesterday fretting over this...


Sub ProcessRanges()
On Error GoTo ExitSub
Dim StartingDateRange As Range, FileName As String
Dim FileNumber As Integer

Set StartingDateRange = Sheet1.[c3]
If Not IsDate(StartingDateRange) Then
MsgBox "Invalid starting date in range " &
StartingDateRange.Address(0, 0)
Exit Sub
End If

Debug.Print ThisWorkbook.Path
FileName = "\\broner\data$\FCDM.dat"

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

If CreateCVS(Sheets("FC1"), StartingDateRange, FileNumber) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If

If CreateCVS(Sheets("FC2"), StartingDateRange, FileNumber) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If

If CreateCVS(Sheets("FC3"), StartingDateRange, FileNumber) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If


ExitSub:
Close #FileNumber


End Sub

Private Function CreateCVS( _
sh As Worksheet, _
StartingDateRange As Range, _
FileNumber As Integer) 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 FirstColumn1 As Integer, LastColumn1 As Integer,
CurrentColumn1 As Integer

Dim ShiftRow As Long, ShiftStatus(1 To 3) As String
Dim ShiftItem As Integer
Dim PreviousShiftStatus As String, 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)

Do

PreviousShiftStatus = "No Previous Status"

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

ConservationShutdown = False



Select Case Trim(UCase(ShiftStatus(ShiftItem)))
Case "X", "O"
CurrentShiftStatus = "U"
Case "", "H"
CurrentShiftStatus = "D"
Case "E"
CurrentShiftStatus = "D"
ConservationShutdown = True


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


'SECOND TAB STARTS HERE

Sheets("FC2").Select

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

ConservationShutdown = False



Select Case Trim(UCase(ShiftStatus(ShiftItem)))
Case "X", "O"
CurrentShiftStatus = "U"
Case "", "H"
CurrentShiftStatus = "D"
Case "E"
CurrentShiftStatus = "D"
ConservationShutdown = True


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

'THIRD TAB STARTS HERE

Sheets("FC3").Select

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

ConservationShutdown = False



Select Case Trim(UCase(ShiftStatus(ShiftItem)))
Case "X", "O"
CurrentShiftStatus = "U"
Case "", "H"
CurrentShiftStatus = "D"
Case "E"
CurrentShiftStatus = "D"
ConservationShutdown = True


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

End If

Set DataRange = DataRange.Offset(6)
UnitNumber = DataRange(1).Offset(, -2)
ShiftRow = DataRange(1).Row
CurrentDate = StartingDateRange


Loop Until Trim(UnitNumber) = ""

CreateCVS = True
Exit Function

Err_CreateCVS:

End Function



joel

Change sheets within a read and write function...
 
You don't need to modify CreateCVS function. The variable sh is passed to
the function which is the worksheet. You already modified the Sub
ProcessRanges() to call CreateCVS three times with a differrent worksheet
name each time.

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


The line Sheets("FC2").Select
does nothing in the code because the code is using the variable sh to select
the appropriate sheets.

"Naji" wrote:

Hello,

I am given the task of expanding an already existing macro, however
I'm a bit novice I suppose and I am stuck with the program not working
with the added changes, so I'm doing it wrong. I have simplified the
code and functionality to better enable me to explain my problem and
hopefully get some helpful feedback that won't confuse the reader.

The macro's purpose is to read production turns for a unit and write
them out into a comma delimited file to be used by production
programs. It goes through a 3-row multiple column range where each row
indicates a shift(morning/mid/night) and each column indicates a date.
The macro's purpose is to detect changes from " " to "X" or from "X"
to " " to indicate time frames when the machine is running as to when
it's "down" and not. Once it goes through this range, it moves on to
the next unit which has its turns listed below it, and so on. These
planned up and down instructions are then fed into the machines
themselves to instruct when they are on or off.

Anyhow, currently the macro and spreadsheet is one single spreadsheet.
I need to expand the workbook to 3 spreadsheets to extend the time
frame further. So for each unit, after it's done with the first
worksheet, it moves on to the second worksheet which is just a
continuation of the first worksheet and basically a twin, with only
the dates and turns different, and then a third.

I just put in a change sheet command and copied and pasted the code
three times to fufill the effect but it is not moving on to the second
and third pages. The dates change forward accordingly, but it just
copies the turns from the first spreadsheet twice instead of reading
in from the second and then third. Please, I know this is a simple
solution to a program that already exists...it's just I'm no expert
and don't want to start this all over just because I don't understand
the existing logic. Your help will make my day! I spent all day
yesterday fretting over this...


Sub ProcessRanges()
On Error GoTo ExitSub
Dim StartingDateRange As Range, FileName As String
Dim FileNumber As Integer

Set StartingDateRange = Sheet1.[c3]
If Not IsDate(StartingDateRange) Then
MsgBox "Invalid starting date in range " &
StartingDateRange.Address(0, 0)
Exit Sub
End If

Debug.Print ThisWorkbook.Path
FileName = "\\broner\data$\FCDM.dat"

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

If CreateCVS(Sheets("FC1"), StartingDateRange, FileNumber) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If

If CreateCVS(Sheets("FC2"), StartingDateRange, FileNumber) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If

If CreateCVS(Sheets("FC3"), StartingDateRange, FileNumber) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If


ExitSub:
Close #FileNumber


End Sub

Private Function CreateCVS( _
sh As Worksheet, _
StartingDateRange As Range, _
FileNumber As Integer) 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 FirstColumn1 As Integer, LastColumn1 As Integer,
CurrentColumn1 As Integer

Dim ShiftRow As Long, ShiftStatus(1 To 3) As String
Dim ShiftItem As Integer
Dim PreviousShiftStatus As String, 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)

Do

PreviousShiftStatus = "No Previous Status"

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

ConservationShutdown = False



Select Case Trim(UCase(ShiftStatus(ShiftItem)))
Case "X", "O"
CurrentShiftStatus = "U"
Case "", "H"
CurrentShiftStatus = "D"
Case "E"
CurrentShiftStatus = "D"
ConservationShutdown = True


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


'SECOND TAB STARTS HERE

Sheets("FC2").Select

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

ConservationShutdown = False



Select Case Trim(UCase(ShiftStatus(ShiftItem)))
Case "X", "O"
CurrentShiftStatus = "U"
Case "", "H"
CurrentShiftStatus = "D"
Case "E"
CurrentShiftStatus = "D"
ConservationShutdown = True


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

'THIRD TAB STARTS HERE

Sheets("FC3").Select

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

ConservationShutdown = False



Select Case Trim(UCase(ShiftStatus(ShiftItem)))
Case "X", "O"
CurrentShiftStatus = "U"
Case "", "H"
CurrentShiftStatus = "D"
Case "E"
CurrentShiftStatus = "D"
ConservationShutdown = True


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

End If

Set DataRange = DataRange.Offset(6)
UnitNumber = DataRange(1).Offset(, -2)
ShiftRow = DataRange(1).Row
CurrentDate = StartingDateRange


Loop Until Trim(UnitNumber) = ""

CreateCVS = True
Exit Function

Err_CreateCVS:


Naji

Change sheets within a read and write function...
 
OK so do I need to create a brand new function that is unit-specific
and goes through three sheets? I say that because CreateCVS needs to
go through sheets 1-3 once for one unit, and then go back to sheet one
and do it again for the next unit. What is the best plan of action? I
went ahead and deleted the modification of the CreateCVS function I
had made, where to go from here? I am really stumped here...I'd
appreciate some direction!



On Jan 8, 9:39*am, Joel wrote:
You don't need to modify CreateCVS function. *The variable sh is passed to
the function which is the worksheet. *You already modified the Sub
ProcessRanges() to call CreateCVS three times with a differrent worksheet
name each time.

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

The line Sheets("FC2").Select
does nothing in the code because the code is using the variable sh to select
the appropriate sheets.



"Naji" wrote:
Hello,


I am given the task of expanding an already existing macro, however
I'm a bit novice I suppose and I am stuck with the program not working
with the added changes, so I'm doing it wrong. I have simplified the
code and functionality to better enable me to explain my problem and
hopefully get some helpful feedback that won't confuse the reader.


The macro's purpose is to read production turns for a unit and write
them out into a comma delimited file to be used by production
programs. It goes through a 3-row multiple column range where each row
indicates a shift(morning/mid/night) and each column indicates a date.
The macro's purpose is to detect changes from " " to "X" or from "X"
to " " to indicate time frames when the machine is running as to when
it's "down" and not. Once it goes through this range, it moves on to
the next unit which has its turns listed below it, and so on. These
planned up and down instructions are then fed into the machines
themselves to instruct when they are on or off.


Anyhow, currently the macro and spreadsheet is one single spreadsheet.
I need to expand the workbook to 3 spreadsheets to extend the time
frame further. So for each unit, after it's done with the first
worksheet, it moves on to the second worksheet which is just a
continuation of the first worksheet and basically a twin, with only
the dates and turns different, and then a third.


I just put in a change sheet command and copied and pasted the code
three times to fufill the effect but it is not moving on to the second
and third pages. The dates change forward accordingly, but it just
copies the turns from the first spreadsheet twice instead of reading
in from the second and then third. Please, I know this is a simple
solution to a program that already exists...it's just I'm no expert
and don't want to start this all over just because I don't understand
the existing logic. Your help will make my day! I spent all day
yesterday fretting over this...


Sub ProcessRanges()
* * On Error GoTo ExitSub
* * Dim StartingDateRange As Range, FileName As String
* * Dim FileNumber As Integer


* * Set StartingDateRange = Sheet1.[c3]
* * If Not IsDate(StartingDateRange) Then
* * * * MsgBox "Invalid starting date in range " &
StartingDateRange.Address(0, 0)
* * * * Exit Sub
* * End If


* * Debug.Print ThisWorkbook.Path
* * FileName = "\\broner\data$\FCDM.dat"


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


* * If CreateCVS(Sheets("FC1"), StartingDateRange, FileNumber) Then
* * * * 'all is well
* * * * Debug.Print "Success..."
* * Else
* * * * 'problem
* * * * Debug.Print "Failure..."
* * End If


* * If CreateCVS(Sheets("FC2"), StartingDateRange, FileNumber) Then
* * * * 'all is well
* * * * Debug.Print "Success..."
* * Else
* * * * 'problem
* * * * Debug.Print "Failure..."
* * End If


* * If CreateCVS(Sheets("FC3"), StartingDateRange, FileNumber) Then
* * * * 'all is well
* * * * Debug.Print "Success..."
* * Else
* * * * 'problem
* * * * Debug.Print "Failure..."
* * End If


ExitSub:
Close #FileNumber


End Sub


Private Function CreateCVS( _
* * sh As Worksheet, _
* * StartingDateRange As Range, _
* * FileNumber As Integer) 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 FirstColumn1 As Integer, LastColumn1 As Integer,
CurrentColumn1 As Integer


* * Dim ShiftRow As Long, ShiftStatus(1 To 3) As String
* * Dim ShiftItem As Integer
* * Dim PreviousShiftStatus As String, 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)


* * Do


* * * * PreviousShiftStatus = "No Previous Status"


* * * * 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


* * * * * * * * * * ConservationShutdown = False


* * * * * * * * * * Select Case Trim(UCase(ShiftStatus(ShiftItem)))
* * * * * * * * * * * * Case "X", "O"
* * * * * * * * * * * * * * CurrentShiftStatus = "U"
* * * * * * * * * * * * Case "", "H"
* * * * * * * * * * * * * * CurrentShiftStatus = "D"
* * * * * * * * * * * * Case "E"
* * * * * * * * * * * * * * CurrentShiftStatus = "D"
* * * * * * * * * * * * * * ConservationShutdown = True


* * * * * * * * * * 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



* * * * End If


* * * * Set DataRange = DataRange.Offset(6)
* * * * UnitNumber = DataRange(1).Offset(, -2)
* * * * ShiftRow = DataRange(1).Row
* * * * CurrentDate = StartingDateRange


* * Loop Until Trim(UnitNumber) = ""


* * CreateCVS = True
* * Exit Function


Err_CreateCVS:- Hide quoted text -


- Show quoted text -



joel

Change sheets within a read and write function...
 
See if this helps. I don't know if I completely understand your code. but I
belive you need to move StartingDateRange down the worksheet 3 rows for each
unit


Sub ProcessRanges()
On Error GoTo ExitSub
Dim StartingDateRange As Range, FileName As String
Dim FileNumber As Integer


Debug.Print ThisWorkbook.Path
FileName = "\\broner\data$\FCDM.dat"

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

For Unit = 0 To 6 Step 2

Set StartingDateRange = Sheet1.Range("C" & (3 + Unit))
If Not IsDate(StartingDateRange) Then
MsgBox "Invalid starting date in range " & _
StartingDateRange.Address(0, 0)
Exit Sub
End If


For sht = 1 To 3
If CreateCVS(Sheets("FC" & sht), StartingDateRange, FileNumber) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If

Next sht
Next Unit

ExitSub:
Close #FileNumber


End Sub

Private Function CreateCVS( _
sh As Worksheet, _
StartingDateRange As Range, _
FileNumber As Integer, Unit As Integer) 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 FirstColumn1 As Integer, LastColumn1 As Integer, _
CurrentColumn1 As Integer

Dim ShiftRow As Long, ShiftStatus(1 To 3) As String
Dim ShiftItem As Integer
Dim PreviousShiftStatus As String, 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)


PreviousShiftStatus = "No Previous Status"

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

ConservationShutdown = False



Select Case Trim(UCase(ShiftStatus(ShiftItem)))
Case "X", "O"
CurrentShiftStatus = "U"
Case "", "H"
CurrentShiftStatus = "D"
Case "E"
CurrentShiftStatus = "D"
ConservationShutdown = True


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

Err_CreateCVS:

End Function


"Naji" wrote:

OK so do I need to create a brand new function that is unit-specific
and goes through three sheets? I say that because CreateCVS needs to
go through sheets 1-3 once for one unit, and then go back to sheet one
and do it again for the next unit. What is the best plan of action? I
went ahead and deleted the modification of the CreateCVS function I
had made, where to go from here? I am really stumped here...I'd
appreciate some direction!



On Jan 8, 9:39 am, Joel wrote:
You don't need to modify CreateCVS function. The variable sh is passed to
the function which is the worksheet. You already modified the Sub
ProcessRanges() to call CreateCVS three times with a differrent worksheet
name each time.

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

The line Sheets("FC2").Select
does nothing in the code because the code is using the variable sh to select
the appropriate sheets.



"Naji" wrote:
Hello,


I am given the task of expanding an already existing macro, however
I'm a bit novice I suppose and I am stuck with the program not working
with the added changes, so I'm doing it wrong. I have simplified the
code and functionality to better enable me to explain my problem and
hopefully get some helpful feedback that won't confuse the reader.


The macro's purpose is to read production turns for a unit and write
them out into a comma delimited file to be used by production
programs. It goes through a 3-row multiple column range where each row
indicates a shift(morning/mid/night) and each column indicates a date.
The macro's purpose is to detect changes from " " to "X" or from "X"
to " " to indicate time frames when the machine is running as to when
it's "down" and not. Once it goes through this range, it moves on to
the next unit which has its turns listed below it, and so on. These
planned up and down instructions are then fed into the machines
themselves to instruct when they are on or off.


Anyhow, currently the macro and spreadsheet is one single spreadsheet.
I need to expand the workbook to 3 spreadsheets to extend the time
frame further. So for each unit, after it's done with the first
worksheet, it moves on to the second worksheet which is just a
continuation of the first worksheet and basically a twin, with only
the dates and turns different, and then a third.


I just put in a change sheet command and copied and pasted the code
three times to fufill the effect but it is not moving on to the second
and third pages. The dates change forward accordingly, but it just
copies the turns from the first spreadsheet twice instead of reading
in from the second and then third. Please, I know this is a simple
solution to a program that already exists...it's just I'm no expert
and don't want to start this all over just because I don't understand
the existing logic. Your help will make my day! I spent all day
yesterday fretting over this...


Sub ProcessRanges()
On Error GoTo ExitSub
Dim StartingDateRange As Range, FileName As String
Dim FileNumber As Integer


Set StartingDateRange = Sheet1.[c3]
If Not IsDate(StartingDateRange) Then
MsgBox "Invalid starting date in range " &
StartingDateRange.Address(0, 0)
Exit Sub
End If


Debug.Print ThisWorkbook.Path
FileName = "\\broner\data$\FCDM.dat"


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


If CreateCVS(Sheets("FC1"), StartingDateRange, FileNumber) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If


If CreateCVS(Sheets("FC2"), StartingDateRange, FileNumber) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If


If CreateCVS(Sheets("FC3"), StartingDateRange, FileNumber) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If


ExitSub:
Close #FileNumber


End Sub


Private Function CreateCVS( _
sh As Worksheet, _
StartingDateRange As Range, _
FileNumber As Integer) 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 FirstColumn1 As Integer, LastColumn1 As Integer,
CurrentColumn1 As Integer


Dim ShiftRow As Long, ShiftStatus(1 To 3) As String
Dim ShiftItem As Integer
Dim PreviousShiftStatus As String, 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)


Do


PreviousShiftStatus = "No Previous Status"


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


ConservationShutdown = False


Select Case Trim(UCase(ShiftStatus(ShiftItem)))
Case "X", "O"
CurrentShiftStatus = "U"
Case "", "H"
CurrentShiftStatus = "D"
Case "E"
CurrentShiftStatus = "D"
ConservationShutdown = True


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



End If


Set DataRange = DataRange.Offset(6)
UnitNumber = DataRange(1).Offset(, -2)
ShiftRow = DataRange(1).Row
CurrentDate = StartingDateRange


Loop Until Trim(UnitNumber) = ""


CreateCVS = True
Exit Function


Err_CreateCVS:- Hide quoted text -


- Show quoted text -




Naji

Change sheets within a read and write function...
 
Thank you for your help! I made a few changes, and it seems to be
running fine, EXCEPT for the fact that it does all units on SHEET1
BEFORE moving to SHEET 2. I need it to do output one unit at a time,
that way when it saves the comma delimited file, it has all the
UNIT1's together, and then all the UNIT2's, etc etc. Unit numbers are
in A4, A10, A16, A22, etc. I do not understand the FOR UNIT loop you
have shown.

Sub ProcessRanges()
On Error GoTo ExitSub
Dim StartingDateRange1 As Range, StartingDateRange2 As Range,
StartingDateRange3 As Range, FileName As String

Dim FileNumber As Integer


Debug.Print ThisWorkbook.Path
FileName = "\\broner\data$\FCDM.dat"


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


For Unit = 0 To 6 Step 2


Set StartingDateRange1 = Sheet1.Range("C3")
Set StartingDateRange2 = Sheet2.Range("C3")
Set StartingDateRange3 = Sheet3.Range("C3")




For sht = 1 To 1
If CreateCVS(Sheets("FC" & sht), StartingDateRange1,
FileNumber) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If


Next sht

For sht = 2 To 2
If CreateCVS(Sheets("FC" & sht), StartingDateRange2,
FileNumber) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If


Next sht

For sht = 3 To 3
If CreateCVS(Sheets("FC" & sht), StartingDateRange3,
FileNumber) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If


Next sht



Next Unit


ExitSub:
Close #FileNumber


End Sub





On Jan 8, 11:47*am, Joel wrote:
See if this helps. *I don't know if I completely understand your code. *but I
belive you need to move StartingDateRange down the worksheet 3 rows for each
unit

Sub ProcessRanges()
* * On Error GoTo ExitSub
* * Dim StartingDateRange As Range, FileName As String
* * Dim FileNumber As Integer

* * Debug.Print ThisWorkbook.Path
* * FileName = "\\broner\data$\FCDM.dat"

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

For Unit = 0 To 6 Step 2

* * Set StartingDateRange = Sheet1.Range("C" & (3 + Unit))
* * If Not IsDate(StartingDateRange) Then
* * * * MsgBox "Invalid starting date in range " & _
* * * * StartingDateRange.Address(0, 0)
* * * * Exit Sub
* * End If

* *For sht = 1 To 3
* * * *If CreateCVS(Sheets("FC" & sht), StartingDateRange, FileNumber) Then
* * * * * *'all is well
* * * * * *Debug.Print "Success..."
* * * *Else
* * * * * *'problem
* * * * * *Debug.Print "Failure..."
* * * *End If

* *Next sht
Next Unit

ExitSub:
Close #FileNumber

End Sub

Private Function CreateCVS( _
* * sh As Worksheet, _
* * StartingDateRange As Range, _
* * FileNumber As Integer, Unit As Integer) 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 FirstColumn1 As Integer, LastColumn1 As Integer, _
* * * *CurrentColumn1 As Integer

* * Dim ShiftRow As Long, ShiftStatus(1 To 3) As String
* * Dim ShiftItem As Integer
* * Dim PreviousShiftStatus As String, 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)

* * * * PreviousShiftStatus = "No Previous Status"

* * * * 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

* * * * * * * * * * ConservationShutdown = False

* * * * * * * * * * Select Case Trim(UCase(ShiftStatus(ShiftItem)))
* * * * * * * * * * * * Case "X", "O"
* * * * * * * * * * * * * * CurrentShiftStatus = "U"
* * * * * * * * * * * * Case "", "H"
* * * * * * * * * * * * * * CurrentShiftStatus = "D"
* * * * * * * * * * * * Case "E"
* * * * * * * * * * * * * * CurrentShiftStatus = "D"
* * * * * * * * * * * * * * ConservationShutdown = True

* * * * * * * * * * 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

Err_CreateCVS:

End Function



"Naji" wrote:
OK so do I need to create a brand new function that is unit-specific
and goes through three sheets? I say that because CreateCVS needs to
go through sheets 1-3 once for one unit, and then go back to sheet one
and do it again for the next unit. What is the best plan of action? I
went ahead and deleted the modification of the CreateCVS function I
had made, where to go from here? I am really stumped here...I'd
appreciate some direction!


On Jan 8, 9:39 am, Joel wrote:
You don't need to modify CreateCVS function. *The variable sh is passed to
the function which is the worksheet. *You already modified the Sub
ProcessRanges() to call CreateCVS three times with a differrent worksheet
name each time.


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


The line Sheets("FC2").Select
does nothing in the code because the code is using the variable sh to select
the appropriate sheets.


"Naji" wrote:
Hello,


I am given the task of expanding an already existing macro, however
I'm a bit novice I suppose and I am stuck with the program not working
with the added changes, so I'm doing it wrong. I have simplified the
code and functionality to better enable me to explain my problem and
hopefully get some helpful feedback that won't confuse the reader.


The macro's purpose is to read production turns for a unit and write
them out into a comma delimited file to be used by production
programs. It goes through a 3-row multiple column range where each row
indicates a shift(morning/mid/night) and each column indicates a date.
The macro's purpose is to detect changes from " " to "X" or from "X"
to " " to indicate time frames when the machine is running as to when
it's "down" and not. Once it goes through this range, it moves on to
the next unit which has its turns listed below it, and so on. These
planned up and down instructions are then fed into the machines
themselves to instruct when they are on or off.


Anyhow, currently the macro and spreadsheet is one single spreadsheet.


Naji

Change sheets within a read and write function...
 
Actually, I had to make one more change. I don't understand your
intended purpose for "For Unit 0 to 6 Step 2" Line. I think you meant
to fufill what i asked for but it did not work. I changed it to this
but now I still have the problem of the macro doing it sheet by sheet
instead of unit by unit. There are multiple units listed on each
sheet.

Sub ProcessRanges()
On Error GoTo ExitSub
Dim StartingDateRange1 As Range, StartingDateRange2 As Range,
StartingDateRange3 As Range, FileName As String


Dim FileNumber As Integer


Debug.Print ThisWorkbook.Path
FileName = "\\broner\data$\FCDM.dat"


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


For Unit = 0 To 6 Step 2


Set StartingDateRange1 = Sheet1.Range("C3")
Set StartingDateRange2 = Sheet2.Range("C3")
Set StartingDateRange3 = Sheet3.Range("C3")


For sht = 1 To 1
If CreateCVS(Sheets("FC" & sht), StartingDateRange1,
FileNumber) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If


Next sht


For sht = 2 To 2
If CreateCVS(Sheets("FC" & sht), StartingDateRange2,
FileNumber) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If


Next sht


For sht = 3 To 3
If CreateCVS(Sheets("FC" & sht), StartingDateRange3,
FileNumber) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If


Next sht


Next Unit


ExitSub:
Close #FileNumber


End Sub





On Jan 8, 1:42*pm, Naji wrote:
Thank you for your help! I made a few changes, and it seems to be
running fine, EXCEPT for the fact that it does all units on SHEET1
BEFORE moving to SHEET 2. I need it to do output one unit at a time,
that way when it saves the comma delimited file, it has all the
UNIT1's together, and then all the UNIT2's, etc etc. Unit numbers are
in A4, A10, A16, A22, etc. I do not understand the FOR UNIT loop you
have shown.

Sub ProcessRanges()
* * On Error GoTo ExitSub
* * Dim StartingDateRange1 As Range, StartingDateRange2 As Range,
StartingDateRange3 As Range, FileName As String

* * Dim FileNumber As Integer

* * Debug.Print ThisWorkbook.Path
* * FileName = "\\broner\data$\FCDM.dat"

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

For Unit = 0 To 6 Step 2

* * Set StartingDateRange1 = Sheet1.Range("C3")
* * Set StartingDateRange2 = Sheet2.Range("C3")
* * Set StartingDateRange3 = Sheet3.Range("C3")

* *For sht = 1 To 1
* * * *If CreateCVS(Sheets("FC" & sht), StartingDateRange1,
FileNumber) Then
* * * * * *'all is well
* * * * * *Debug.Print "Success..."
* * * *Else
* * * * * *'problem
* * * * * *Debug.Print "Failure..."
* * * *End If

* *Next sht

* * * For sht = 2 To 2
* * * *If CreateCVS(Sheets("FC" & sht), StartingDateRange2,
FileNumber) Then
* * * * * *'all is well
* * * * * *Debug.Print "Success..."
* * * *Else
* * * * * *'problem
* * * * * *Debug.Print "Failure..."
* * * *End If

* * * Next sht

* * * *For sht = 3 To 3
* * * *If CreateCVS(Sheets("FC" & sht), StartingDateRange3,
FileNumber) Then
* * * * * *'all is well
* * * * * *Debug.Print "Success..."
* * * *Else
* * * * * *'problem
* * * * * *Debug.Print "Failure..."
* * * *End If

* * * Next sht

Next Unit

ExitSub:
Close #FileNumber

End Sub

On Jan 8, 11:47*am, Joel wrote:



See if this helps. *I don't know if I completely understand your code. *but I
belive you need to move StartingDateRange down the worksheet 3 rows for each
unit


Sub ProcessRanges()
* * On Error GoTo ExitSub
* * Dim StartingDateRange As Range, FileName As String
* * Dim FileNumber As Integer


* * Debug.Print ThisWorkbook.Path
* * FileName = "\\broner\data$\FCDM.dat"


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


For Unit = 0 To 6 Step 2


* * Set StartingDateRange = Sheet1.Range("C" & (3 + Unit))
* * If Not IsDate(StartingDateRange) Then
* * * * MsgBox "Invalid starting date in range " & _
* * * * StartingDateRange.Address(0, 0)
* * * * Exit Sub
* * End If


* *For sht = 1 To 3
* * * *If CreateCVS(Sheets("FC" & sht), StartingDateRange, FileNumber) Then
* * * * * *'all is well
* * * * * *Debug.Print "Success..."
* * * *Else
* * * * * *'problem
* * * * * *Debug.Print "Failure..."
* * * *End If


* *Next sht
Next Unit


ExitSub:
Close #FileNumber


End Sub


Private Function CreateCVS( _
* * sh As Worksheet, _
* * StartingDateRange As Range, _
* * FileNumber As Integer, Unit As Integer) 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 FirstColumn1 As Integer, LastColumn1 As Integer, _
* * * *CurrentColumn1 As Integer


* * Dim ShiftRow As Long, ShiftStatus(1 To 3) As String
* * Dim ShiftItem As Integer
* * Dim PreviousShiftStatus As String, 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)


* * * * PreviousShiftStatus = "No Previous Status"


* * * * 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


* * * * * * * * * * ConservationShutdown = False


* * * * * * * * * * Select Case Trim(UCase(ShiftStatus(ShiftItem)))
* * * * * * * * * * * * Case "X", "O"
* * * * * * * * * * * * * * CurrentShiftStatus = "U"
* * * * * * * * * * * * Case "", "H"
* * * * * * * * * * * * * * CurrentShiftStatus = "D"
* * * * * * * * * * * * Case "E"
* * * * * * * * * * * * * * CurrentShiftStatus = "D"
* * * * * * * * * * * * * * ConservationShutdown = True


* * * * * * * * * * 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


Err_CreateCVS:


End Function


"Naji" wrote:
OK so do I need to create a brand new function that is unit-specific
and goes through three sheets? I say that because CreateCVS needs to
go through sheets 1-3 once for one unit, and then go back to sheet one
and do it again for the next unit. What is the best plan of action? I
went ahead and deleted the modification of the CreateCVS function I
had made, where to go from here? I am really stumped here...I'd
appreciate some direction!


On Jan 8, 9:39 am, Joel wrote:
You don't need to modify CreateCVS function. *The variable sh is passed to
the function which is the worksheet. *You already modified the Sub
ProcessRanges() to call CreateCVS three times with a differrent worksheet
name each time.


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


The line Sheets("FC2").Select
does nothing in the code because the code is using the variable sh to select
the appropriate sheets.


"Naji" wrote:
Hello,


I am given the task of expanding an already existing macro, however
I'm a bit novice I suppose and I am stuck with the program not working
with the added changes, so I'm doing it wrong. I have simplified the
code and functionality to better enable me to explain my problem and
hopefully get some helpful feedback that won't confuse the reader.


The macro's purpose is to read production turns for a unit and write
them out into a comma delimited file to be used by production
programs. It goes through a 3-row multiple column range where each row
indicates a shift(morning/mid/night) and each column indicates a date.
The macro's purpose is to detect changes from " " to "X" or from "X"
to " " to indicate time frames when the machine is running as to when
it's "down" and not. Once it goes through this range, it moves on to
the next unit which has its turns listed below it, and so on. These
planned up and down instructions are then fed into the machines
themselves to instruct when they are on or off.


Anyhow, currently the macro and spreadsheet is one single spreadsheet.
I need to expand the workbook to 3 spreadsheets to extend the time
frame further. So for each unit, after it's done with the first
worksheet, it moves on to the second worksheet which is just a
continuation of the first worksheet and basically a twin, with only
the dates and turns different, and then a third.


I just put in a change sheet command and copied and pasted the code
three times to fufill the effect but it is not moving on to the second
and third pages. The dates change forward accordingly, but it just
copies the turns from the first spreadsheet twice instead of reading
in from the second and then third. Please, I know this is a simple
solution to a program that already exists...it's just I'm no expert
and don't want to start this all over just because I don't understand
the existing logic. Your help will make my day! I spent all day
yesterday fretting over this...


Sub ProcessRanges()
* * On Error GoTo ExitSub
* * Dim StartingDateRange As Range, FileName As String
* * Dim FileNumber As Integer


* * Set StartingDateRange = Sheet1.[c3]
* * If Not IsDate(StartingDateRange) Then
* * * * MsgBox "Invalid starting date in range " &
StartingDateRange.Address(0, 0)
* * * * Exit Sub
* * End If


* * Debug.Print ThisWorkbook.Path


...

read more »- Hide quoted text -

- Show quoted text -



joel

Change sheets within a read and write function...
 
change 2 to 3
from
For Unit = 0 To 6 Step 2
to
For Unit = 0 To 6 Step 3

from your original posting you said the following
where each row indicates a shift(morning/mid/night) and each column
indicates a date.

It looks like each item consits of 3 rows. The StartingDateRange date is in
colum
C. I was trying to move down the worksheet and set a new StartingDateRange
for each item. It seems you code keys on the StartingDateRange. To get get
the next item the StartingDateRange must be changed.

Your code should set the StartingDateRange and then call the funcxttion
CreateCVS 3 times (once for each sheet). Then change the StartingDateRange
and again call the CreateCVS function 3 times.

if you noticed I removed the do loop from inside the CreateCVS function and
tried to add the same looping into the Sub ProcessRanges(). I did this
because you didn't want the UnitNumber to increase until all 3 sheets were
processed.


"Naji" wrote:

Actually, I had to make one more change. I don't understand your
intended purpose for "For Unit 0 to 6 Step 2" Line. I think you meant
to fufill what i asked for but it did not work. I changed it to this
but now I still have the problem of the macro doing it sheet by sheet
instead of unit by unit. There are multiple units listed on each
sheet.

Sub ProcessRanges()
On Error GoTo ExitSub
Dim StartingDateRange1 As Range, StartingDateRange2 As Range,
StartingDateRange3 As Range, FileName As String


Dim FileNumber As Integer


Debug.Print ThisWorkbook.Path
FileName = "\\broner\data$\FCDM.dat"


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


For Unit = 0 To 6 Step 2


Set StartingDateRange1 = Sheet1.Range("C3")
Set StartingDateRange2 = Sheet2.Range("C3")
Set StartingDateRange3 = Sheet3.Range("C3")


For sht = 1 To 1
If CreateCVS(Sheets("FC" & sht), StartingDateRange1,
FileNumber) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If


Next sht


For sht = 2 To 2
If CreateCVS(Sheets("FC" & sht), StartingDateRange2,
FileNumber) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If


Next sht


For sht = 3 To 3
If CreateCVS(Sheets("FC" & sht), StartingDateRange3,
FileNumber) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If


Next sht


Next Unit


ExitSub:
Close #FileNumber


End Sub





On Jan 8, 1:42 pm, Naji wrote:
Thank you for your help! I made a few changes, and it seems to be
running fine, EXCEPT for the fact that it does all units on SHEET1
BEFORE moving to SHEET 2. I need it to do output one unit at a time,
that way when it saves the comma delimited file, it has all the
UNIT1's together, and then all the UNIT2's, etc etc. Unit numbers are
in A4, A10, A16, A22, etc. I do not understand the FOR UNIT loop you
have shown.

Sub ProcessRanges()
On Error GoTo ExitSub
Dim StartingDateRange1 As Range, StartingDateRange2 As Range,
StartingDateRange3 As Range, FileName As String

Dim FileNumber As Integer

Debug.Print ThisWorkbook.Path
FileName = "\\broner\data$\FCDM.dat"

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

For Unit = 0 To 6 Step 2

Set StartingDateRange1 = Sheet1.Range("C3")
Set StartingDateRange2 = Sheet2.Range("C3")
Set StartingDateRange3 = Sheet3.Range("C3")

For sht = 1 To 1
If CreateCVS(Sheets("FC" & sht), StartingDateRange1,
FileNumber) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If

Next sht

For sht = 2 To 2
If CreateCVS(Sheets("FC" & sht), StartingDateRange2,
FileNumber) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If

Next sht

For sht = 3 To 3
If CreateCVS(Sheets("FC" & sht), StartingDateRange3,
FileNumber) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If

Next sht

Next Unit

ExitSub:
Close #FileNumber

End Sub

On Jan 8, 11:47 am, Joel wrote:



See if this helps. I don't know if I completely understand your code. but I
belive you need to move StartingDateRange down the worksheet 3 rows for each
unit


Sub ProcessRanges()
On Error GoTo ExitSub
Dim StartingDateRange As Range, FileName As String
Dim FileNumber As Integer


Debug.Print ThisWorkbook.Path
FileName = "\\broner\data$\FCDM.dat"


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


For Unit = 0 To 6 Step 2


Set StartingDateRange = Sheet1.Range("C" & (3 + Unit))
If Not IsDate(StartingDateRange) Then
MsgBox "Invalid starting date in range " & _
StartingDateRange.Address(0, 0)
Exit Sub
End If


For sht = 1 To 3
If CreateCVS(Sheets("FC" & sht), StartingDateRange, FileNumber) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If


Next sht
Next Unit


ExitSub:
Close #FileNumber


End Sub


Private Function CreateCVS( _
sh As Worksheet, _
StartingDateRange As Range, _
FileNumber As Integer, Unit As Integer) 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 FirstColumn1 As Integer, LastColumn1 As Integer, _
CurrentColumn1 As Integer


Dim ShiftRow As Long, ShiftStatus(1 To 3) As String
Dim ShiftItem As Integer
Dim PreviousShiftStatus As String, 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)


PreviousShiftStatus = "No Previous Status"


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


ConservationShutdown = False


Select Case Trim(UCase(ShiftStatus(ShiftItem)))
Case "X", "O"
CurrentShiftStatus = "U"
Case "", "H"
CurrentShiftStatus = "D"
Case "E"
CurrentShiftStatus = "D"
ConservationShutdown = True


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


Err_CreateCVS:


End Function


"Naji" wrote:
OK so do I need to create a brand new function that is unit-specific
and goes through three sheets? I say that because CreateCVS needs to
go through sheets 1-3 once for one unit, and then go back to sheet one
and do it again for the next unit. What is the best plan of action? I
went ahead and deleted the modification of the CreateCVS function I
had made, where to go from here? I am really stumped here...I'd
appreciate some direction!


On Jan 8, 9:39 am, Joel wrote:
You don't need to modify CreateCVS function. The variable sh is passed to


Naji

Change sheets within a read and write function...
 
Thanks again for all your help. You are a true blessing! I went ahead
and implemented what you suggested, however now I'm getting a ByRef
Argument Type Mismatch For Unit in CreateCVS.

--- It doesn't like this line: If CreateCVS(Sheets("FC" & Sht),
StartingDateRange, FileNumber, Unit) Then


Just to clarify, the actual Unit Number printed out in the output file
is a String. It looks through every unit that isn't assigned a "0" in
the Unit number field. That field happens to be in A4, A10, A16, etc.
The units are "86", "2C", "26", etc. Wow you are up at 4:00am my time.
Where do you live?? I'm in California...


Here is the entire code I have as of right now:

Sub ProcessRanges()
On Error GoTo ExitSub
Dim StartingDateRange As Range, FileName As String
Dim FileNumber As Integer



Debug.Print ThisWorkbook.Path
FileName = "\\broner\data$\FCDM.dat"


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



For Unit = 0 To 6 Step 3


Set StartingDateRange = Sheet1.Range("C3")

If Not IsDate(StartingDateRange) Then
MsgBox "Invalid starting date in range " & _
StartingDateRange.Address(0, 0)
Exit Sub
End If


For Sht = 1 To 3

If CreateCVS(Sheets("FC" & Sht), StartingDateRange, FileNumber,
Unit) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If

Next Sht

Set StartingDateRange = Sheet2.Range("C3")

If Not IsDate(StartingDateRange) Then
MsgBox "Invalid starting date in range " & _
StartingDateRange.Address(0, 0)
Exit Sub
End If



For Sht = 1 To 3

If CreateCVS(Sheets("FC" & Sht), StartingDateRange,
FileNumber, Unit) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If



Next Sht


Set StartingDateRange = Sheet3.Range("C3")


If Not IsDate(StartingDateRange) Then
MsgBox "Invalid starting date in range " & _
StartingDateRange.Address(0, 0)
Exit Sub
End If



For Sht = 1 To 3
If CreateCVS(Sheets("FC" & Sht), StartingDateRange, FileNumber,
Unit) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If

Next Sht


Next Unit


ExitSub:
Close #FileNumber


End Sub


Private Function CreateCVS( _
sh As Worksheet, _
StartingDateRange As Range, _
FileNumber As Integer, Unit As Integer) 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 FirstColumn1 As Integer, LastColumn1 As Integer, _
CurrentColumn1 As Integer


Dim ShiftRow As Long, ShiftStatus(1 To 3) As String
Dim ShiftItem As Integer
Dim PreviousShiftStatus As String, 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)


PreviousShiftStatus = "No Previous Status"


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


ConservationShutdown = False


Select Case Trim(UCase(ShiftStatus(ShiftItem)))
Case "X", "O"
CurrentShiftStatus = "U"
Case "", "H"
CurrentShiftStatus = "D"
Case "E"
CurrentShiftStatus = "D"
ConservationShutdown = True


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


Err_CreateCVS:


End Function










On Jan 9, 4:01*am, Joel wrote:
change 2 to 3
from
*For Unit = 0 To 6 Step 2
to
*For Unit = 0 To 6 Step 3

from your original posting you said the following
where each row indicates a shift(morning/mid/night) and each column
indicates a date.

It looks like each item consits of 3 rows. *The StartingDateRange date is in
colum
C. *I was trying to move down the worksheet and set a new StartingDateRange
for each item. *It seems you code keys on the StartingDateRange. *To get get
the next item the StartingDateRange must be changed.

Your code should set the StartingDateRange and then call the funcxttion
CreateCVS 3 times (once for each sheet). *Then change the StartingDateRange
and again call the CreateCVS function 3 times.

if you noticed I removed the do loop from inside the CreateCVS function and
tried to add the same looping into the Sub ProcessRanges(). *I did this
because you didn't want the UnitNumber to increase until all 3 sheets were
processed.



"Naji" wrote:
Actually, I had to make one more change. I don't understand your
intended purpose for "For Unit 0 to 6 Step 2" Line. I think you meant
to fufill what i asked for but it did not work. I changed it to this
but now I still have the problem of the macro doing it sheet by sheet
instead of unit by unit. There are multiple units listed on each
sheet.


Sub ProcessRanges()
* * On Error GoTo ExitSub
* * Dim StartingDateRange1 As Range, StartingDateRange2 As Range,
StartingDateRange3 As Range, FileName As String


* * Dim FileNumber As Integer


* * Debug.Print ThisWorkbook.Path
* * FileName = "\\broner\data$\FCDM.dat"


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


For Unit = 0 To 6 Step 2


* * Set StartingDateRange1 = Sheet1.Range("C3")
* * Set StartingDateRange2 = Sheet2.Range("C3")
* * Set StartingDateRange3 = Sheet3.Range("C3")


* *For sht = 1 To 1
* * * *If CreateCVS(Sheets("FC" & sht), StartingDateRange1,
FileNumber) Then
* * * * * *'all is well
* * * * * *Debug.Print "Success..."
* * * *Else
* * * * * *'problem
* * * * * *Debug.Print "Failure..."
* * * *End If


* *Next sht


* * * For sht = 2 To 2
* * * *If CreateCVS(Sheets("FC" & sht), StartingDateRange2,
FileNumber) Then
* * * * * *'all is well
* * * * * *Debug.Print "Success..."
* * * *Else
* * * * * *'problem
* * * * * *Debug.Print "Failure..."
* * * *End If


* * * Next sht


* * * *For sht = 3 To 3
* * * *If CreateCVS(Sheets("FC" & sht), StartingDateRange3,
FileNumber) Then
* * * * * *'all is well
* * * * * *Debug.Print "Success..."
* * * *Else
* * * * * *'problem
* * * * * *Debug.Print "Failure..."
* * * *End If


* * * Next sht


Next Unit


ExitSub:
Close #FileNumber


End Sub


On Jan 8, 1:42 wrote:
Thank you for your help! I made a few changes, and it seems to be
running fine, EXCEPT for the fact that it does all units on SHEET1
BEFORE moving to SHEET 2. I need it to do output one unit at a time,
that way when it saves the comma delimited file, it has all the
UNIT1's together, and then all the UNIT2's, etc etc. Unit numbers are
in A4, A10, A16, A22, etc. I do not understand the FOR UNIT loop you
have shown.


Sub ProcessRanges()
* * On Error GoTo ExitSub
* * Dim StartingDateRange1 As Range, StartingDateRange2 As Range,
StartingDateRange3 As Range, FileName As String


* * Dim FileNumber As Integer


* * Debug.Print ThisWorkbook.Path
* * FileName = "\\broner\data$\FCDM.dat"


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


For Unit = 0 To 6 Step 2


* * Set StartingDateRange1 = Sheet1.Range("C3")
* * Set StartingDateRange2 = Sheet2.Range("C3")
* * Set StartingDateRange3 = Sheet3.Range("C3")


* *For sht = 1 To 1
* * * *If CreateCVS(Sheets("FC" & sht), StartingDateRange1,
FileNumber) Then
* * * * * *'all is well
* * * * * *Debug.Print "Success..."
* * * *Else
* * * * * *'problem
* * * * * *Debug.Print "Failure..."
* * * *End If


* *Next sht


* * * For sht = 2 To 2
* * * *If CreateCVS(Sheets("FC" & sht), StartingDateRange2,
FileNumber) Then
* * * * * *'all is well
* * * * * *Debug.Print "Success..."
* * * *Else
* * * * * *'problem
* * * * * *Debug.Print "Failure..."
* * * *End If


* * * Next sht


* * * *For sht = 3 To 3
* * * *If CreateCVS(Sheets("FC" & sht), StartingDateRange3,
FileNumber) Then
* * * * * *'all is well
* * * * * *Debug.Print "Success..."
* * * *Else
* * * * * *'problem
* * * * * *Debug.Print "Failure..."
* * * *End If


* * * Next sht


Next Unit


ExitSub:
Close #FileNumber


End Sub


On Jan 8, 11:47 am, Joel wrote:


See if this helps. *I don't know if I completely understand your code. *but I
belive you need to move StartingDateRange down the worksheet 3 rows for each
unit


Sub ProcessRanges()
* * On Error GoTo ExitSub
* * Dim StartingDateRange As Range, FileName As String
* * Dim FileNumber As Integer


* * Debug.Print ThisWorkbook.Path
* * FileName = "\\broner\data$\FCDM.dat"


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


For Unit = 0 To 6 Step 2


* * Set StartingDateRange = Sheet1.Range("C" & (3 + Unit))
* * If Not IsDate(StartingDateRange) Then
* * * * MsgBox "Invalid starting date in range " & _
* * * * StartingDateRange.Address(0, 0)
* * * * Exit Sub
* * End If


* *For sht = 1 To 3
* * * *If CreateCVS(Sheets("FC" & sht), StartingDateRange, FileNumber) Then
* * * * * *'all is well
* * * * * *Debug.Print "Success..."
* * * *Else
* * * * * *'problem
* * * * * *Debug.Print "Failure..."
* * * *End If


* *Next sht
Next Unit


ExitSub:
Close #FileNumber


End Sub


Private Function CreateCVS( _
* * sh As Worksheet, _
* * StartingDateRange As Range, _
* * FileNumber As Integer, Unit As Integer) 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 FirstColumn1 As Integer, LastColumn1 As Integer, _
* * * *CurrentColumn1 As Integer


* * Dim ShiftRow As Long, ShiftStatus(1 To 3) As String
* * Dim ShiftItem As Integer
* * Dim PreviousShiftStatus As String, 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)


* * * * PreviousShiftStatus = "No Previous Status"


* * * * 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


* * * * * * * * * * ConservationShutdown = False


* * * * * * * * * * Select Case Trim(UCase(ShiftStatus(ShiftItem)))
* * * * * * * * * * * * Case "X", "O"
* * * * * * * * * * * * * * CurrentShiftStatus = "U"
* * * * * * * * * * * * Case "", "H"
* * * * * * * * * * * * * * CurrentShiftStatus = "D"
* * * * * * * * * * * * Case "E"
* * * * * * * * * * * * * * CurrentShiftStatus = "D"
* * * * * * * * * * * * * * ConservationShutdown = True


* * * * * * * * * * 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


Err_CreateCVS:


End Function


"Naji" wrote:
OK so do I need to create a brand new function that is unit-specific
and goes through three sheets? I say that because CreateCVS needs to
go through sheets 1-3 once for one unit, and then go back to sheet one
and do it again for the next unit. What is the best plan of action? I
went ahead and deleted the modification of the CreateCVS function I
had made, where to go from here? I am really stumped here...I'd
appreciate some direction!


On Jan 8, 9:39 am, Joel wrote:
You don't need to modify CreateCVS function. *The variable sh is passed to- Hide quoted text -


- Show quoted text -



joel

Change sheets within a read and write function...
 
The easiest way of fixing the error is to add the folllowing

Dim Unit As Integer to Sub ProcessRanges()

You are also missing an End If statement.

"Naji" wrote:

Thanks again for all your help. You are a true blessing! I went ahead
and implemented what you suggested, however now I'm getting a ByRef
Argument Type Mismatch For Unit in CreateCVS.

--- It doesn't like this line: If CreateCVS(Sheets("FC" & Sht),
StartingDateRange, FileNumber, Unit) Then


Just to clarify, the actual Unit Number printed out in the output file
is a String. It looks through every unit that isn't assigned a "0" in
the Unit number field. That field happens to be in A4, A10, A16, etc.
The units are "86", "2C", "26", etc. Wow you are up at 4:00am my time.
Where do you live?? I'm in California...


Here is the entire code I have as of right now:

Sub ProcessRanges()
On Error GoTo ExitSub
Dim StartingDateRange As Range, FileName As String
Dim FileNumber As Integer



Debug.Print ThisWorkbook.Path
FileName = "\\broner\data$\FCDM.dat"


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



For Unit = 0 To 6 Step 3


Set StartingDateRange = Sheet1.Range("C3")

If Not IsDate(StartingDateRange) Then
MsgBox "Invalid starting date in range " & _
StartingDateRange.Address(0, 0)
Exit Sub
End If


For Sht = 1 To 3

If CreateCVS(Sheets("FC" & Sht), StartingDateRange, FileNumber,
Unit) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If

Next Sht

Set StartingDateRange = Sheet2.Range("C3")

If Not IsDate(StartingDateRange) Then
MsgBox "Invalid starting date in range " & _
StartingDateRange.Address(0, 0)
Exit Sub
End If



For Sht = 1 To 3

If CreateCVS(Sheets("FC" & Sht), StartingDateRange,
FileNumber, Unit) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If



Next Sht


Set StartingDateRange = Sheet3.Range("C3")


If Not IsDate(StartingDateRange) Then
MsgBox "Invalid starting date in range " & _
StartingDateRange.Address(0, 0)
Exit Sub
End If



For Sht = 1 To 3
If CreateCVS(Sheets("FC" & Sht), StartingDateRange, FileNumber,
Unit) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If

Next Sht


Next Unit


ExitSub:
Close #FileNumber


End Sub


Private Function CreateCVS( _
sh As Worksheet, _
StartingDateRange As Range, _
FileNumber As Integer, Unit As Integer) 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 FirstColumn1 As Integer, LastColumn1 As Integer, _
CurrentColumn1 As Integer


Dim ShiftRow As Long, ShiftStatus(1 To 3) As String
Dim ShiftItem As Integer
Dim PreviousShiftStatus As String, 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)


PreviousShiftStatus = "No Previous Status"


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


ConservationShutdown = False


Select Case Trim(UCase(ShiftStatus(ShiftItem)))
Case "X", "O"
CurrentShiftStatus = "U"
Case "", "H"
CurrentShiftStatus = "D"
Case "E"
CurrentShiftStatus = "D"
ConservationShutdown = True


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


Err_CreateCVS:


End Function










On Jan 9, 4:01 am, Joel wrote:
change 2 to 3
from
For Unit = 0 To 6 Step 2
to
For Unit = 0 To 6 Step 3

from your original posting you said the following
where each row indicates a shift(morning/mid/night) and each column
indicates a date.

It looks like each item consits of 3 rows. The StartingDateRange date is in
colum
C. I was trying to move down the worksheet and set a new StartingDateRange
for each item. It seems you code keys on the StartingDateRange. To get get
the next item the StartingDateRange must be changed.

Your code should set the StartingDateRange and then call the funcxttion
CreateCVS 3 times (once for each sheet). Then change the StartingDateRange
and again call the CreateCVS function 3 times.

if you noticed I removed the do loop from inside the CreateCVS function and
tried to add the same looping into the Sub ProcessRanges(). I did this
because you didn't want the UnitNumber to increase until all 3 sheets were
processed.



"Naji" wrote:
Actually, I had to make one more change. I don't understand your
intended purpose for "For Unit 0 to 6 Step 2" Line. I think you meant
to fufill what i asked for but it did not work. I changed it to this
but now I still have the problem of the macro doing it sheet by sheet
instead of unit by unit. There are multiple units listed on each
sheet.


Sub ProcessRanges()
On Error GoTo ExitSub
Dim StartingDateRange1 As Range, StartingDateRange2 As Range,
StartingDateRange3 As Range, FileName As String


Dim FileNumber As Integer


Debug.Print ThisWorkbook.Path
FileName = "\\broner\data$\FCDM.dat"


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


For Unit = 0 To 6 Step 2


Set StartingDateRange1 = Sheet1.Range("C3")
Set StartingDateRange2 = Sheet2.Range("C3")
Set StartingDateRange3 = Sheet3.Range("C3")


For sht = 1 To 1
If CreateCVS(Sheets("FC" & sht), StartingDateRange1,
FileNumber) Then
'all is well
Debug.Print "Success..."
Else


Naji

Change sheets within a read and write function...
 
The For Unit = 0 To 6 Step 3 line causes the code to just repeat the
first unit 6 times. It goes through 3 sheets for the first unit 6
times instead of moving down to the next unit..I played around with it
and didn't get it to work. I changed it to this, and it doesn't repeat
the same unit, it just takes the first unit on the first sheet and
goes through the following sheets accordingly, however it does not go
down from the first unit range of A4:A6 to the second units range of
A10:A12 to do the same thing for the next unit. Sorry this must be
frustrating to you, but I really appreciate the help it just is not
working as expected and I'm still stuck!!

Forever grateful...Here's my code:

Sub ProcessRanges()
On Error GoTo ExitSub
Dim StartingDateRange As Range, FileName As String
Dim FileNumber As Integer
Dim Unit As Integer




Debug.Print ThisWorkbook.Path
FileName = "\\broner\data$\FCDM.dat"


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



For Unit = 0 To 1 Step 3


Set StartingDateRange = Sheet1.Range("C3")

If Not IsDate(StartingDateRange) Then
MsgBox "Invalid starting date in range " & _
StartingDateRange.Address(0, 0)
Exit Sub
End If


For Sht = 1 To 3

If CreateCVS(Sheets("FC" & Sht), StartingDateRange, FileNumber,
Unit) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If

Next Sht

Set StartingDateRange = Sheet2.Range("C3")

If Not IsDate(StartingDateRange) Then
MsgBox "Invalid starting date in range " & _
StartingDateRange.Address(0, 0)
Exit Sub
End If



For Sht = 1 To 3

If CreateCVS(Sheets("FC" & Sht), StartingDateRange, FileNumber,
Unit) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If



Next Sht


Set StartingDateRange = Sheet3.Range("C3")


If Not IsDate(StartingDateRange) Then
MsgBox "Invalid starting date in range " & _
StartingDateRange.Address(0, 0)
Exit Sub
End If



For Sht = 1 To 3
If CreateCVS(Sheets("FC" & Sht), StartingDateRange, FileNumber,
Unit) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If

Next Sht


Next Unit


ExitSub:
Close #FileNumber


End Sub


Private Function CreateCVS( _
sh As Worksheet, _
StartingDateRange As Range, _
FileNumber As Integer, Unit As Integer) 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 FirstColumn1 As Integer, LastColumn1 As Integer, _
CurrentColumn1 As Integer


Dim ShiftRow As Long, ShiftStatus(1 To 3) As String
Dim ShiftItem As Integer
Dim PreviousShiftStatus As String, 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)


PreviousShiftStatus = "No Previous Status"


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


ConservationShutdown = False


Select Case Trim(UCase(ShiftStatus(ShiftItem)))
Case "X", "O"
CurrentShiftStatus = "U"
Case "", "H"
CurrentShiftStatus = "D"
Case "E"
CurrentShiftStatus = "D"
ConservationShutdown = True


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






On Jan 9, 9:08*am, Joel wrote:
The easiest way of fixing the error is to add *the folllowing

* * Dim Unit As Integer to Sub ProcessRanges()

You are also missing an End If statement.



"Naji" wrote:
Thanks again for all your help. You are a true blessing! I went ahead
and implemented what you suggested, however now I'm getting a ByRef
Argument Type Mismatch For Unit in CreateCVS.


--- It doesn't like this line: If CreateCVS(Sheets("FC" & Sht),
StartingDateRange, FileNumber, Unit) Then


Just to clarify, the actual Unit Number printed out in the output file
is a String. It looks through every unit that isn't assigned a "0" in
the Unit number field. That field happens to be in A4, A10, A16, etc.
The units are "86", "2C", "26", etc. Wow you are up at 4:00am my time.
Where do you live?? I'm in California...


Here is the entire code I have as of right now:


Sub ProcessRanges()
* * On Error GoTo ExitSub
* * Dim StartingDateRange As Range, FileName As String
* * Dim FileNumber As Integer


* * Debug.Print ThisWorkbook.Path
* * FileName = "\\broner\data$\FCDM.dat"


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


For Unit = 0 To 6 Step 3


* * Set StartingDateRange = Sheet1.Range("C3")


* * If Not IsDate(StartingDateRange) Then
* * * * MsgBox "Invalid starting date in range " & _
* * * * StartingDateRange.Address(0, 0)
* * * * Exit Sub
* * End If


* * For Sht = 1 To 3


* * * *If CreateCVS(Sheets("FC" & Sht), StartingDateRange, FileNumber,
Unit) Then
* * * * * *'all is well
* * * * * *Debug.Print "Success..."
* * * *Else
* * * * * *'problem
* * * * * *Debug.Print "Failure..."
* * * *End If


* * Next Sht


* * Set StartingDateRange = Sheet2.Range("C3")


* * If Not IsDate(StartingDateRange) Then
* * * * MsgBox "Invalid starting date in range " & _
* * * * StartingDateRange.Address(0, 0)
* * * * Exit Sub
* * End If


* * * For Sht = 1 To 3


* * * * If CreateCVS(Sheets("FC" & Sht), StartingDateRange,
FileNumber, Unit) Then
* * * * * *'all is well
* * * * * *Debug.Print "Success..."
* * * *Else
* * * * * *'problem
* * * * * *Debug.Print "Failure..."
* * * *End If


* * * *Next Sht


* * Set StartingDateRange = Sheet3.Range("C3")


* * If Not IsDate(StartingDateRange) Then
* * * * MsgBox "Invalid starting date in range " & _
* * * * StartingDateRange.Address(0, 0)
* * * * Exit Sub
* * End If


* *For Sht = 1 To 3
* * * *If CreateCVS(Sheets("FC" & Sht), StartingDateRange, FileNumber,
Unit) Then
* * * * * *'all is well
* * * * * *Debug.Print "Success..."
* * * *Else
* * * * * *'problem
* * * * * *Debug.Print "Failure..."
* * * *End If


* * * *Next Sht


Next Unit


ExitSub:
Close #FileNumber


End Sub


Private Function CreateCVS( _
* * sh As Worksheet, _
* * StartingDateRange As Range, _
* * FileNumber As Integer, Unit As Integer) 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 FirstColumn1 As Integer, LastColumn1 As Integer, _
* * * *CurrentColumn1 As Integer


* * Dim ShiftRow As Long, ShiftStatus(1 To 3) As String
* * Dim ShiftItem As Integer
* * Dim PreviousShiftStatus As String, 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)


* * * * PreviousShiftStatus = "No Previous Status"


* * * * 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


* * * * * * * * * * ConservationShutdown = False


* * * * * * * * * * Select Case Trim(UCase(ShiftStatus(ShiftItem)))
* * * * * * * * * * * * Case "X", "O"
* * * * * * * * * * * * * * CurrentShiftStatus = "U"
* * * * * * * * * * * * Case "", "H"
* * * * * * * * * * * * * * CurrentShiftStatus = "D"
* * * * * * * * * * * * Case "E"
* * * * * * * * * * * * * * CurrentShiftStatus = "D"
* * * * * * * * * * * * * * ConservationShutdown = True


* * * * * * * * * * 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


Err_CreateCVS:


End Function


On Jan 9, 4:01 am, Joel wrote:
change 2 to 3
from
*For Unit = 0 To 6 Step 2
to
*For Unit = 0 To 6 Step 3


from your original posting you said the following
where each row indicates a shift(morning/mid/night) and each column
indicates a date.


It looks like each item consits of 3 rows. *The StartingDateRange date is in
colum
C. *I was trying to move down the worksheet and set a new StartingDateRange
for each item. *It seems you code keys on the StartingDateRange. *To get get
the next item the StartingDateRange must be changed.


Your code should set the StartingDateRange and then call the funcxttion
CreateCVS 3 times (once for each sheet). *Then change the StartingDateRange
and again call the CreateCVS function 3 times.


if you noticed I removed the do loop from inside the CreateCVS function and
tried to add the same looping into the Sub ProcessRanges(). *I did this
because you didn't want the UnitNumber to increase until all 3 sheets were
processed.


"Naji" wrote:
Actually, I had to make one more change. I don't understand your
intended purpose for "For Unit 0 to 6 Step 2" Line. I think you meant
to fufill what i asked for but it did not work. I changed it to this
but now I still have the problem of the macro doing it sheet by sheet
instead of unit by unit. There are multiple units listed on each
sheet.


Sub ProcessRanges()
* * On Error GoTo ExitSub
* * Dim StartingDateRange1 As Range, StartingDateRange2 As Range,
StartingDateRange3 As Range, FileName As String


* * Dim FileNumber As Integer


* * Debug.Print ThisWorkbook.Path
* * FileName = "\\broner\data$\FCDM.dat"


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


For Unit = 0 To 6 Step 2


* * Set StartingDateRange1 = Sheet1.Range("C3")
* * Set StartingDateRange2 = Sheet2.Range("C3")
* * Set StartingDateRange3 = Sheet3.Range("C3")


* *For sht = 1 To 1
* * * *If CreateCVS(Sheets("FC" & sht), StartingDateRange1,
FileNumber) Then
* * * * * *'all is well
* * * * * *Debug.Print "Success..."
* * * *Else- Hide quoted text -


- Show quoted text -



joel

Change sheets within a read and write function...
 
Simple

Sub ProcessRanges()
On Error GoTo ExitSub
Dim StartingDateRange As Range, FileName As String
Dim FileNumber As Integer
Dim Unit As Integer




Debug.Print ThisWorkbook.Path
FileName = "\\broner\data$\FCDM.dat"


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


LastRow = Sheet1.Range("C" & Rows.Count).End(xlUp).Row
RowCount = 1
Do While RowCount <= LastRow


Set StartingDateRange = Sheet1.Range("C" & (RowCount + 2))

If Not IsDate(StartingDateRange) Then
MsgBox "Invalid starting date in range " & _
StartingDateRange.Address(0, 0)
Exit Sub
End If


For Sht = 1 To 3

If CreateCVS(Sheets("FC" & Sht), StartingDateRange, FileNumber) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If

Next Sht

RowCount = RowCount + 3
Loop


ExitSub:
Close #FileNumber


End Sub


Private Function CreateCVS( _
sh As Worksheet, _
StartingDateRange As Range, _
FileNumber As Integer) 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 FirstColumn1 As Integer, LastColumn1 As Integer, _
CurrentColumn1 As Integer


Dim ShiftRow As Long, ShiftStatus(1 To 3) As String
Dim ShiftItem As Integer
Dim PreviousShiftStatus As String, 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)


PreviousShiftStatus = "No Previous Status"


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


ConservationShutdown = False


Select Case Trim(UCase(ShiftStatus(ShiftItem)))
Case "X", "O"
CurrentShiftStatus = "U"
Case "", "H"
CurrentShiftStatus = "D"
Case "E"
CurrentShiftStatus = "D"
ConservationShutdown = True


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



"Naji" wrote:

The For Unit = 0 To 6 Step 3 line causes the code to just repeat the
first unit 6 times. It goes through 3 sheets for the first unit 6
times instead of moving down to the next unit..I played around with it
and didn't get it to work. I changed it to this, and it doesn't repeat
the same unit, it just takes the first unit on the first sheet and
goes through the following sheets accordingly, however it does not go
down from the first unit range of A4:A6 to the second units range of
A10:A12 to do the same thing for the next unit. Sorry this must be
frustrating to you, but I really appreciate the help it just is not
working as expected and I'm still stuck!!

Forever grateful...Here's my code:

Sub ProcessRanges()
On Error GoTo ExitSub
Dim StartingDateRange As Range, FileName As String
Dim FileNumber As Integer
Dim Unit As Integer




Debug.Print ThisWorkbook.Path
FileName = "\\broner\data$\FCDM.dat"


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



For Unit = 0 To 1 Step 3


Set StartingDateRange = Sheet1.Range("C3")

If Not IsDate(StartingDateRange) Then
MsgBox "Invalid starting date in range " & _
StartingDateRange.Address(0, 0)
Exit Sub
End If


For Sht = 1 To 3

If CreateCVS(Sheets("FC" & Sht), StartingDateRange, FileNumber,
Unit) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If

Next Sht

Set StartingDateRange = Sheet2.Range("C3")

If Not IsDate(StartingDateRange) Then
MsgBox "Invalid starting date in range " & _
StartingDateRange.Address(0, 0)
Exit Sub
End If



For Sht = 1 To 3

If CreateCVS(Sheets("FC" & Sht), StartingDateRange, FileNumber,
Unit) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If



Next Sht


Set StartingDateRange = Sheet3.Range("C3")


If Not IsDate(StartingDateRange) Then
MsgBox "Invalid starting date in range " & _
StartingDateRange.Address(0, 0)
Exit Sub
End If



For Sht = 1 To 3
If CreateCVS(Sheets("FC" & Sht), StartingDateRange, FileNumber,
Unit) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If

Next Sht


Next Unit


ExitSub:
Close #FileNumber


End Sub


Private Function CreateCVS( _
sh As Worksheet, _
StartingDateRange As Range, _
FileNumber As Integer, Unit As Integer) 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 FirstColumn1 As Integer, LastColumn1 As Integer, _
CurrentColumn1 As Integer


Dim ShiftRow As Long, ShiftStatus(1 To 3) As String
Dim ShiftItem As Integer
Dim PreviousShiftStatus As String, 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)


PreviousShiftStatus = "No Previous Status"


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


ConservationShutdown = False


Select Case Trim(UCase(ShiftStatus(ShiftItem)))
Case "X", "O"
CurrentShiftStatus = "U"
Case "", "H"
CurrentShiftStatus = "D"
Case "E"
CurrentShiftStatus = "D"
ConservationShutdown = True


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






On Jan 9, 9:08 am, Joel wrote:
The easiest way of fixing the error is to add the folllowing

Dim Unit As Integer to Sub ProcessRanges()

You are also missing an End If statement.



"Naji" wrote:
Thanks again for all your help. You are a true blessing! I went ahead
and implemented what you suggested, however now I'm getting a ByRef
Argument Type Mismatch For Unit in CreateCVS.


--- It doesn't like this line: If CreateCVS(Sheets("FC" & Sht),
StartingDateRange, FileNumber, Unit) Then


Just to clarify, the actual Unit Number printed out in the output file
is a String. It looks through every unit that isn't assigned a "0" in
the Unit number field. That field happens to be in A4, A10, A16, etc.
The units are "86", "2C", "26", etc. Wow you are up at 4:00am my time.
Where do you live?? I'm in California...


Here is the entire code I have as of right now:


Sub ProcessRanges()
On Error GoTo ExitSub
Dim StartingDateRange As Range, FileName As String
Dim FileNumber As Integer


Debug.Print ThisWorkbook.Path
FileName = "\\broner\data$\FCDM.dat"


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


For Unit = 0 To 6 Step 3


Set StartingDateRange = Sheet1.Range("C3")


If Not IsDate(StartingDateRange) Then
MsgBox "Invalid starting date in range " & _
StartingDateRange.Address(0, 0)
Exit Sub
End If


For Sht = 1 To 3


If CreateCVS(Sheets("FC" & Sht), StartingDateRange, FileNumber,
Unit) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If


Next Sht


Set StartingDateRange = Sheet2.Range("C3")


If Not IsDate(StartingDateRange) Then
MsgBox "Invalid starting date in range " & _
StartingDateRange.Address(0, 0)
Exit Sub
End If


Naji

Change sheets within a read and write function...
 
Yes thanks, but as it moves from one sheet to the next, it does not
remember the previous shift status, causing it to double up in the
output txt file. How can I carry PreviousShiftStatus from one sheet to
the next?

On Jan 10, 3:56*am, Joel wrote:
Simple

Sub ProcessRanges()
* * On Error GoTo ExitSub
* * Dim StartingDateRange As Range, FileName As String
* * Dim FileNumber As Integer
* * Dim Unit As Integer

* * Debug.Print ThisWorkbook.Path
* * FileName = "\\broner\data$\FCDM.dat"

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

LastRow = Sheet1.Range("C" & Rows.Count).End(xlUp).Row
RowCount = 1
Do While RowCount <= LastRow

* * Set StartingDateRange = Sheet1.Range("C" & (RowCount + 2))

* * If Not IsDate(StartingDateRange) Then
* * * * MsgBox "Invalid starting date in range " & _
* * * * StartingDateRange.Address(0, 0)
* * * * Exit Sub
* * End If

* * For Sht = 1 To 3

* * * *If CreateCVS(Sheets("FC" & Sht), StartingDateRange, FileNumber) Then
* * * * * *'all is well
* * * * * *Debug.Print "Success..."
* * * *Else
* * * * * *'problem
* * * * * *Debug.Print "Failure..."
* * * *End If

* * Next Sht

* *RowCount = RowCount + 3
Loop

ExitSub:
Close #FileNumber

End Sub

Private Function CreateCVS( _
* * sh As Worksheet, _
* * StartingDateRange As Range, _
* * FileNumber As Integer) 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 FirstColumn1 As Integer, LastColumn1 As Integer, _
* * * *CurrentColumn1 As Integer

* * Dim ShiftRow As Long, ShiftStatus(1 To 3) As String
* * Dim ShiftItem As Integer
* * Dim PreviousShiftStatus As String, 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)

* * * * PreviousShiftStatus = "No Previous Status"

* * * * 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

* * * * * * * * * * ConservationShutdown = False

* * * * * * * * * * Select Case Trim(UCase(ShiftStatus(ShiftItem)))
* * * * * * * * * * * * Case "X", "O"
* * * * * * * * * * * * * * CurrentShiftStatus = "U"
* * * * * * * * * * * * Case "", "H"
* * * * * * * * * * * * * * CurrentShiftStatus = "D"
* * * * * * * * * * * * Case "E"
* * * * * * * * * * * * * * CurrentShiftStatus = "D"
* * * * * * * * * * * * * * ConservationShutdown = True

* * * * * * * * * * 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



"Naji" wrote:
The For Unit = 0 To 6 Step 3 line causes the code to just repeat the
first unit 6 times. It goes through 3 sheets for the first unit 6
times instead of moving down to the next unit..I played around with it
and didn't get it to work. I changed it to this, and it doesn't repeat
the same unit, it just takes the first unit on the first sheet and
goes through the following sheets accordingly, however it does not go
down from the first unit range of A4:A6 to the second units range of
A10:A12 to do the same thing for the next unit. Sorry this must be
frustrating to you, but I really appreciate the help it just is not
working as expected and I'm still stuck!!


Forever grateful...Here's my code:


Sub ProcessRanges()
* * On Error GoTo ExitSub
* * Dim StartingDateRange As Range, FileName As String
* * Dim FileNumber As Integer
* * Dim Unit As Integer


* * Debug.Print ThisWorkbook.Path
* * FileName = "\\broner\data$\FCDM.dat"


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


For Unit = 0 To 1 Step 3


* * Set StartingDateRange = Sheet1.Range("C3")


* * If Not IsDate(StartingDateRange) Then
* * * * MsgBox "Invalid starting date in range " & _
* * * * StartingDateRange.Address(0, 0)
* * * * Exit Sub
* * End If


* * For Sht = 1 To 3


* * * *If CreateCVS(Sheets("FC" & Sht), StartingDateRange, FileNumber,
Unit) Then
* * * * * *'all is well
* * * * * *Debug.Print "Success..."
* * * *Else
* * * * * *'problem
* * * * * *Debug.Print "Failure..."
* * * *End If


* * Next Sht


* * Set StartingDateRange = Sheet2.Range("C3")


* * If Not IsDate(StartingDateRange) Then
* * * * MsgBox "Invalid starting date in range " & _
* * * * StartingDateRange.Address(0, 0)
* * * * Exit Sub
* * End If


* * * For Sht = 1 To 3


* * * *If CreateCVS(Sheets("FC" & Sht), StartingDateRange, FileNumber,
Unit) Then
* * * * * *'all is well
* * * * * *Debug.Print "Success..."
* * * *Else
* * * * * *'problem
* * * * * *Debug.Print "Failure..."
* * * *End If


* * * *Next Sht


* * Set StartingDateRange = Sheet3.Range("C3")


* * If Not IsDate(StartingDateRange) Then
* * * * MsgBox "Invalid starting date in range " & _
* * * * StartingDateRange.Address(0, 0)
* * * * Exit Sub
* * End If


* *For Sht = 1 To 3
* * * *If CreateCVS(Sheets("FC" & Sht), StartingDateRange, FileNumber,
Unit) Then
* * * * * *'all is well
* * * * * *Debug.Print "Success..."
* * * *Else
* * * * * *'problem
* * * * * *Debug.Print "Failure..."
* * * *End If


* * * *Next Sht


Next Unit


ExitSub:
Close #FileNumber


End Sub


Private Function CreateCVS( _
* * sh As Worksheet, _
* * StartingDateRange As Range, _
* * FileNumber As Integer, Unit As Integer) 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 FirstColumn1 As Integer, LastColumn1 As Integer, _
* * * *CurrentColumn1 As Integer


* * Dim ShiftRow As Long, ShiftStatus(1 To 3) As String
* * Dim ShiftItem As Integer
* * Dim PreviousShiftStatus As String, 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)


* * * * PreviousShiftStatus = "No Previous Status"


* * * * 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


* * * * * * * * * * ConservationShutdown = False


* * * * * * * * * * Select Case Trim(UCase(ShiftStatus(ShiftItem)))
* * * * * * * * * * * * Case "X", "O"
* * * * * * * * * * * * * * CurrentShiftStatus = "U"
* * * * * * * * * * * * Case "", "H"
* * * * * * * * * * * * * * CurrentShiftStatus = "D"
* * * * * * * * * * * * Case "E"
* * * * * * * * * * * * * * CurrentShiftStatus = "D"
* * * * * * * * * * * * * * ConservationShutdown = True


* * * * * * * * * * 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


On Jan 9, 9:08 am, Joel wrote:
The easiest way of fixing the error is to add *the folllowing


* * Dim Unit As Integer to Sub ProcessRanges()


You are also missing an End If statement.


"Naji" wrote:
Thanks again for all your help. You are a true blessing! I went ahead
and implemented what you suggested, however now I'm getting a ByRef
Argument Type Mismatch For Unit in CreateCVS.


--- It doesn't like this line: If CreateCVS(Sheets("FC" & Sht),
StartingDateRange, FileNumber, Unit) Then


Just to clarify, the actual Unit Number printed out


...

read more »- Hide quoted text -

- Show quoted text -



Naji

Change sheets within a read and write function...
 
Thank You Joel, anyways for your help and time. You are a truly kind
and understanding person.


On Jan 10, 3:59*pm, Naji wrote:
Yes thanks, but as it moves from one sheet to the next, it does not
remember the previous shift status, causing it to double up in the
output txt file. How can I carry PreviousShiftStatus from one sheet to
the next?

On Jan 10, 3:56*am, Joel wrote:



Simple


Sub ProcessRanges()
* * On Error GoTo ExitSub
* * Dim StartingDateRange As Range, FileName As String
* * Dim FileNumber As Integer
* * Dim Unit As Integer


* * Debug.Print ThisWorkbook.Path
* * FileName = "\\broner\data$\FCDM.dat"


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


LastRow = Sheet1.Range("C" & Rows.Count).End(xlUp).Row
RowCount = 1
Do While RowCount <= LastRow


* * Set StartingDateRange = Sheet1.Range("C" & (RowCount + 2))


* * If Not IsDate(StartingDateRange) Then
* * * * MsgBox "Invalid starting date in range " & _
* * * * StartingDateRange.Address(0, 0)
* * * * Exit Sub
* * End If


* * For Sht = 1 To 3


* * * *If CreateCVS(Sheets("FC" & Sht), StartingDateRange, FileNumber) Then
* * * * * *'all is well
* * * * * *Debug.Print "Success..."
* * * *Else
* * * * * *'problem
* * * * * *Debug.Print "Failure..."
* * * *End If


* * Next Sht


* *RowCount = RowCount + 3
Loop


ExitSub:
Close #FileNumber


End Sub


Private Function CreateCVS( _
* * sh As Worksheet, _
* * StartingDateRange As Range, _
* * FileNumber As Integer) 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 FirstColumn1 As Integer, LastColumn1 As Integer, _
* * * *CurrentColumn1 As Integer


* * Dim ShiftRow As Long, ShiftStatus(1 To 3) As String
* * Dim ShiftItem As Integer
* * Dim PreviousShiftStatus As String, 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)


* * * * PreviousShiftStatus = "No Previous Status"


* * * * 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


* * * * * * * * * * ConservationShutdown = False


* * * * * * * * * * Select Case Trim(UCase(ShiftStatus(ShiftItem)))
* * * * * * * * * * * * Case "X", "O"
* * * * * * * * * * * * * * CurrentShiftStatus = "U"
* * * * * * * * * * * * Case "", "H"
* * * * * * * * * * * * * * CurrentShiftStatus = "D"
* * * * * * * * * * * * Case "E"
* * * * * * * * * * * * * * CurrentShiftStatus = "D"
* * * * * * * * * * * * * * ConservationShutdown = True


* * * * * * * * * * 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


"Naji" wrote:
The For Unit = 0 To 6 Step 3 line causes the code to just repeat the
first unit 6 times. It goes through 3 sheets for the first unit 6
times instead of moving down to the next unit..I played around with it
and didn't get it to work. I changed it to this, and it doesn't repeat
the same unit, it just takes the first unit on the first sheet and
goes through the following sheets accordingly, however it does not go
down from the first unit range of A4:A6 to the second units range of
A10:A12 to do the same thing for the next unit. Sorry this must be
frustrating to you, but I really appreciate the help it just is not
working as expected and I'm still stuck!!


Forever grateful...Here's my code:


Sub ProcessRanges()
* * On Error GoTo ExitSub
* * Dim StartingDateRange As Range, FileName As String
* * Dim FileNumber As Integer
* * Dim Unit As Integer


* * Debug.Print ThisWorkbook.Path
* * FileName = "\\broner\data$\FCDM.dat"


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


For Unit = 0 To 1 Step 3


* * Set StartingDateRange = Sheet1.Range("C3")


* * If Not IsDate(StartingDateRange) Then
* * * * MsgBox "Invalid starting date in range " & _
* * * * StartingDateRange.Address(0, 0)
* * * * Exit Sub
* * End If


* * For Sht = 1 To 3


* * * *If CreateCVS(Sheets("FC" & Sht), StartingDateRange, FileNumber,
Unit) Then
* * * * * *'all is well
* * * * * *Debug.Print "Success..."
* * * *Else
* * * * * *'problem
* * * * * *Debug.Print "Failure..."
* * * *End If


* * Next Sht


* * Set StartingDateRange = Sheet2.Range("C3")


* * If Not IsDate(StartingDateRange) Then
* * * * MsgBox "Invalid starting date in range " & _
* * * * StartingDateRange.Address(0, 0)
* * * * Exit Sub
* * End If


* * * For Sht = 1 To 3


* * * *If CreateCVS(Sheets("FC" & Sht), StartingDateRange, FileNumber,
Unit) Then
* * * * * *'all is well
* * * * * *Debug.Print "Success..."
* * * *Else
* * * * * *'problem
* * * * * *Debug.Print "Failure..."
* * * *End If


* * * *Next Sht


* * Set StartingDateRange = Sheet3.Range("C3")


* * If Not IsDate(StartingDateRange) Then
* * * * MsgBox "Invalid starting date in range " & _
* * * * StartingDateRange.Address(0, 0)
* * * * Exit Sub
* * End If


* *For Sht = 1 To 3
* * * *If CreateCVS(Sheets("FC" & Sht), StartingDateRange, FileNumber,
Unit) Then
* * * * * *'all is well
* * * * * *Debug.Print "Success..."
* * * *Else
* * * * * *'problem
* * * * * *Debug.Print "Failure..."
* * * *End If


* * * *Next Sht


Next Unit


ExitSub:
Close #FileNumber


End Sub


Private Function CreateCVS( _
* * sh As Worksheet, _
* * StartingDateRange As Range, _
* * FileNumber As Integer, Unit As Integer) 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 FirstColumn1 As Integer, LastColumn1 As Integer, _
* * * *CurrentColumn1 As Integer


* * Dim ShiftRow As Long, ShiftStatus(1 To 3) As String
* * Dim ShiftItem As Integer
* * Dim PreviousShiftStatus As String, 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)


* * * * PreviousShiftStatus = "No Previous Status"


* * * * 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


* * * * * * * * * * ConservationShutdown = False


* * * * * * * * * * Select Case Trim(UCase(ShiftStatus(ShiftItem)))
* * * * * * * * * * * * Case "X", "O"
* * * * * * * * * * * * * * CurrentShiftStatus = "U"
* * * * * * * * * * * * Case "", "H"
* * * * * * * * * * * * * * CurrentShiftStatus = "D"
* * * * * * * * * * * * Case "E"
* * * * * * * * * * * * * * CurrentShiftStatus = "D"
* * * * * * * * * * * * * *


...

read more »- Hide quoted text -

- Show quoted text -



joel

Change sheets within a read and write function...
 
See if this helps. I changed how PreviousShiftStatus was set. It is now
passed as a parameter to the CVS function. I also made it BYREF so when it
get changed in the function the new value gets passed back out of the
function.


Sub ProcessRanges()
On Error GoTo ExitSub
Dim StartingDateRange As Range, FileName As String
Dim FileNumber As Integer
Dim Unit As Integer
Dim PreviousShiftStatus As String



Debug.Print ThisWorkbook.Path
FileName = "\\broner\data$\FCDM.dat"


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


LastRow = Sheet1.Range("C" & Rows.Count).End(xlUp).Row
RowCount = 1
Do While RowCount <= LastRow


Set StartingDateRange = Sheet1.Range("C" & (RowCount + 2))

If Not IsDate(StartingDateRange) Then
MsgBox "Invalid starting date in range " & _
StartingDateRange.Address(0, 0)
Exit Sub
End If


PreviousShiftStatus = "No Previous Status"
For Sht = 1 To 3

If CreateCVS(Sheets("FC" & Sht), StartingDateRange, _
FileNumber, PreviousShiftStatus) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If

Next Sht

RowCount = RowCount + 3
Loop


ExitSub:
Close #FileNumber


End Sub


Private Function CreateCVS( _
sh As Worksheet, _
StartingDateRange As Range, _
FileNumber As Integer, _
ByRef 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 FirstColumn1 As Integer, LastColumn1 As Integer, _
CurrentColumn1 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


ConservationShutdown = False


Select Case Trim(UCase(ShiftStatus(ShiftItem)))
Case "X", "O"
CurrentShiftStatus = "U"
Case "", "H"
CurrentShiftStatus = "D"
Case "E"
CurrentShiftStatus = "D"
ConservationShutdown = True


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


"Naji" wrote:

Thank You Joel, anyways for your help and time. You are a truly kind
and understanding person.


On Jan 10, 3:59 pm, Naji wrote:
Yes thanks, but as it moves from one sheet to the next, it does not
remember the previous shift status, causing it to double up in the
output txt file. How can I carry PreviousShiftStatus from one sheet to
the next?

On Jan 10, 3:56 am, Joel wrote:



Simple


Sub ProcessRanges()
On Error GoTo ExitSub
Dim StartingDateRange As Range, FileName As String
Dim FileNumber As Integer
Dim Unit As Integer


Debug.Print ThisWorkbook.Path
FileName = "\\broner\data$\FCDM.dat"


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


LastRow = Sheet1.Range("C" & Rows.Count).End(xlUp).Row
RowCount = 1
Do While RowCount <= LastRow


Set StartingDateRange = Sheet1.Range("C" & (RowCount + 2))


If Not IsDate(StartingDateRange) Then
MsgBox "Invalid starting date in range " & _
StartingDateRange.Address(0, 0)
Exit Sub
End If


For Sht = 1 To 3


If CreateCVS(Sheets("FC" & Sht), StartingDateRange, FileNumber) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If


Next Sht


RowCount = RowCount + 3
Loop


ExitSub:
Close #FileNumber


End Sub


Private Function CreateCVS( _
sh As Worksheet, _
StartingDateRange As Range, _
FileNumber As Integer) 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 FirstColumn1 As Integer, LastColumn1 As Integer, _
CurrentColumn1 As Integer


Dim ShiftRow As Long, ShiftStatus(1 To 3) As String
Dim ShiftItem As Integer
Dim PreviousShiftStatus As String, 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)


PreviousShiftStatus = "No Previous Status"


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


ConservationShutdown = False


Select Case Trim(UCase(ShiftStatus(ShiftItem)))
Case "X", "O"
CurrentShiftStatus = "U"
Case "", "H"
CurrentShiftStatus = "D"
Case "E"
CurrentShiftStatus = "D"
ConservationShutdown = True


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


"Naji" wrote:
The For Unit = 0 To 6 Step 3 line causes the code to just repeat the
first unit 6 times. It goes through 3 sheets for the first unit 6
times instead of moving down to the next unit..I played around with it
and didn't get it to work. I changed it to this, and it doesn't repeat
the same unit, it just takes the first unit on the first sheet and
goes through the following sheets accordingly, however it does not go
down from the first unit range of A4:A6 to the second units range of
A10:A12 to do the same thing for the next unit. Sorry this must be
frustrating to you, but I really appreciate the help it just is not
working as expected and I'm still stuck!!


Forever grateful...Here's my code:


Sub ProcessRanges()
On Error GoTo ExitSub
Dim StartingDateRange As Range, FileName As String
Dim FileNumber As Integer
Dim Unit As Integer


Debug.Print ThisWorkbook.Path
FileName = "\\broner\data$\FCDM.dat"


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


For Unit = 0 To 1 Step 3


Set StartingDateRange = Sheet1.Range("C3")


If Not IsDate(StartingDateRange) Then
MsgBox "Invalid starting date in range " & _
StartingDateRange.Address(0, 0)
Exit Sub
End If


For Sht = 1 To 3


If CreateCVS(Sheets("FC" & Sht), StartingDateRange, FileNumber,
Unit) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If


Next Sht


Set StartingDateRange = Sheet2.Range("C3")


If Not IsDate(StartingDateRange) Then
MsgBox "Invalid starting date in range " & _
StartingDateRange.Address(0, 0)
Exit Sub
End If


For Sht = 1 To 3


If CreateCVS(Sheets("FC" & Sht), StartingDateRange, FileNumber,
Unit) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If


Next Sht


Set StartingDateRange = Sheet3.Range("C3")


If Not IsDate(StartingDateRange) Then
MsgBox "Invalid starting date in range " & _
StartingDateRange.Address(0, 0)
Exit Sub
End If


For Sht = 1 To 3
If CreateCVS(Sheets("FC" & Sht), StartingDateRange, FileNumber,
Unit) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If


Next Sht


Next Unit


ExitSub:
Close #FileNumber


End Sub


Private Function CreateCVS( _
sh As Worksheet, _
StartingDateRange As Range, _
FileNumber As Integer, Unit As Integer) 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 FirstColumn1 As Integer, LastColumn1 As Integer, _
CurrentColumn1 As Integer


Dim ShiftRow As Long, ShiftStatus(1 To 3) As String
Dim ShiftItem As Integer
Dim PreviousShiftStatus As String, 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)


PreviousShiftStatus = "No Previous Status"


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


ConservationShutdown = False


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


Naji

Change sheets within a read and write function...
 
Thank You Very Much For your kind help! It helped tremendously!


All times are GMT +1. The time now is 05:22 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com