Change sheets within a read and write function...

N

Naji

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
 
J

Joel

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 said:
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:
Click to expand...
 
N

Naji

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!



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 said:
Hello,
Click to expand...
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.
Click to expand...
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.
Click to expand...
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.
Click to expand...
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...
Click to expand...
Sub ProcessRanges()
    On Error GoTo ExitSub
    Dim StartingDateRange As Range, FileName As String
    Dim FileNumber As Integer
Click to expand...
    Set StartingDateRange = Sheet1.[c3]
    If Not IsDate(StartingDateRange) Then
        MsgBox "Invalid starting date in range " &
StartingDateRange.Address(0, 0)
        Exit Sub
    End If
Click to expand...
    Debug.Print ThisWorkbook.Path
    FileName = "\\broner\data$\FCDM.dat"
Click to expand...
    FileNumber = FreeFile()
    Open FileName For Output As #FileNumber
Click to expand...
    If CreateCVS(Sheets("FC1"), StartingDateRange, FileNumber) Then
        'all is well
        Debug.Print "Success..."
    Else
        'problem
        Debug.Print "Failure..."
    End If
Click to expand...
    If CreateCVS(Sheets("FC2"), StartingDateRange, FileNumber) Then
        'all is well
        Debug.Print "Success..."
    Else
        'problem
        Debug.Print "Failure..."
    End If
Click to expand...
    If CreateCVS(Sheets("FC3"), StartingDateRange, FileNumber) Then
        'all is well
        Debug.Print "Success..."
    Else
        'problem
        Debug.Print "Failure..."
    End If
Click to expand...
ExitSub:
Close #FileNumber
Click to expand...
End Sub
Click to expand...
Private Function CreateCVS( _
    sh As Worksheet, _
    StartingDateRange As Range, _
    FileNumber As Integer) As Boolean
Click to expand...
    On Error GoTo Err_CreateCVS
Click to expand...
    Dim UnitNumber As String, CurrentDate As Date
    Dim DataRange As Range
Click to expand...
    Dim FirstColumn As Integer, LastColumn As Integer, CurrentColumn
As Integer
    Dim FirstColumn1 As Integer, LastColumn1 As Integer,
CurrentColumn1 As Integer
Click to expand...
    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
Click to expand...
    Dim i As Integer
Click to expand...
    'Data Range starts with first schedule box. Everything else is
offset according to this cell
Click to expand...
    Set DataRange = sh.Range(StartingDateRange.Offset(1), _
        StartingDateRange.End(xlToRight).Offset(3))
Click to expand...
        Debug.Print DataRange(1).Address
Click to expand...
    FirstColumn = DataRange(1).Column
    LastColumn = FirstColumn + DataRange.Columns.Count - 1
    ShiftRow = DataRange(1).Row
    UnitNumber = DataRange(1).Offset(, -2)
    CurrentDate = DateValue(StartingDateRange)
Click to expand...
    Do
Click to expand...
        PreviousShiftStatus = "No Previous Status"
Click to expand...
        If UnitNumber <> "0" Then
             For CurrentColumn = FirstColumn To LastColumn
Click to expand...
                ShiftStatus(1) = sh.Cells(ShiftRow, CurrentColumn)
                ShiftStatus(2) = sh.Cells(ShiftRow + 1, CurrentColumn)
                ShiftStatus(3) = sh.Cells(ShiftRow + 2, CurrentColumn)
Click to expand...
                For ShiftItem = 1 To 3
Click to expand...
                    ConservationShutdown = False
Click to expand...
                    Select Case Trim(UCase(ShiftStatus(ShiftItem)))
                        Case "X", "O"
                            CurrentShiftStatus = "U"
                        Case "", "H"
                            CurrentShiftStatus = "D"
                        Case "E"
                            CurrentShiftStatus = "D"
                            ConservationShutdown = True
Click to expand...
                    End Select
Click to expand...
                        If PreviousShiftStatus <> CurrentShiftStatus
Then
Click to expand...
                                    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")
Click to expand...
                        End If
Click to expand...
                    PreviousShiftStatus = CurrentShiftStatus
                Next
Click to expand...
                CurrentDate = CurrentDate + 1
Click to expand...
            Next

        End If
Click to expand...
        Set DataRange = DataRange.Offset(6)
        UnitNumber = DataRange(1).Offset(, -2)
        ShiftRow = DataRange(1).Row
        CurrentDate = StartingDateRange
Click to expand...
    Loop Until Trim(UnitNumber) = ""
Click to expand...
    CreateCVS = True
    Exit Function
Click to expand...
Err_CreateCVS:- Hide quoted text -
Click to expand...

- Show quoted text -
Click to expand...
 
J

Joel

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 said:
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!



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 said:
Hello,
Click to expand...
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.
Click to expand...
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.
Click to expand...
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.
Click to expand...
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...
Click to expand...
Sub ProcessRanges()
On Error GoTo ExitSub
Dim StartingDateRange As Range, FileName As String
Dim FileNumber As Integer
Click to expand...
Set StartingDateRange = Sheet1.[c3]
If Not IsDate(StartingDateRange) Then
MsgBox "Invalid starting date in range " &
StartingDateRange.Address(0, 0)
Exit Sub
End If
Click to expand...
Debug.Print ThisWorkbook.Path
FileName = "\\broner\data$\FCDM.dat"
Click to expand...
FileNumber = FreeFile()
Open FileName For Output As #FileNumber
Click to expand...
If CreateCVS(Sheets("FC1"), StartingDateRange, FileNumber) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If
Click to expand...
If CreateCVS(Sheets("FC2"), StartingDateRange, FileNumber) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If
Click to expand...
If CreateCVS(Sheets("FC3"), StartingDateRange, FileNumber) Then
'all is well
Debug.Print "Success..."
Else
'problem
Debug.Print "Failure..."
End If
Click to expand...
ExitSub:
Close #FileNumber
Click to expand...
End Sub
Click to expand...
Private Function CreateCVS( _
sh As Worksheet, _
StartingDateRange As Range, _
FileNumber As Integer) As Boolean
Click to expand...
On Error GoTo Err_CreateCVS
Click to expand...
Dim UnitNumber As String, CurrentDate As Date
Dim DataRange As Range
Click to expand...
Dim FirstColumn As Integer, LastColumn As Integer, CurrentColumn
As Integer
Dim FirstColumn1 As Integer, LastColumn1 As Integer,
CurrentColumn1 As Integer
Click to expand...
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
Click to expand...
Dim i As Integer
Click to expand...
'Data Range starts with first schedule box. Everything else is
offset according to this cell
Click to expand...
Set DataRange = sh.Range(StartingDateRange.Offset(1), _
StartingDateRange.End(xlToRight).Offset(3))
Click to expand...
Debug.Print DataRange(1).Address
Click to expand...
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"
Click to expand...
If UnitNumber <> "0" Then
For CurrentColumn = FirstColumn To LastColumn
Click to expand...
ShiftStatus(1) = sh.Cells(ShiftRow, CurrentColumn)
ShiftStatus(2) = sh.Cells(ShiftRow + 1, CurrentColumn)
ShiftStatus(3) = sh.Cells(ShiftRow + 2, CurrentColumn)
Click to expand...
For ShiftItem = 1 To 3
Click to expand...
ConservationShutdown = False
Click to expand...
Select Case Trim(UCase(ShiftStatus(ShiftItem)))
Case "X", "O"
CurrentShiftStatus = "U"
Case "", "H"
CurrentShiftStatus = "D"
Case "E"
CurrentShiftStatus = "D"
ConservationShutdown = True
Click to expand...
End Select
Click to expand...
If PreviousShiftStatus <> CurrentShiftStatus
Then
Click to expand...
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")
Click to expand...
End If
Click to expand...
PreviousShiftStatus = CurrentShiftStatus
Next
Click to expand...
CurrentDate = CurrentDate + 1


End If
Click to expand...
Set DataRange = DataRange.Offset(6)
UnitNumber = DataRange(1).Offset(, -2)
ShiftRow = DataRange(1).Row
CurrentDate = StartingDateRange
Click to expand...
Loop Until Trim(UnitNumber) = ""
Click to expand...
CreateCVS = True
Exit Function
Click to expand...
Err_CreateCVS:- Hide quoted text -
Click to expand...

- Show quoted text -
Click to expand...
Click to expand...
 
N

Naji

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





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 said:
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!
Click to expand...
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.
:
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)
Click to expand...
Click to expand...

...

read more »- Hide quoted text -

- Show quoted text -
Click to expand...
 
N

Naji

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





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

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
Click to expand...
Sub ProcessRanges()
    On Error GoTo ExitSub
    Dim StartingDateRange As Range, FileName As String
    Dim FileNumber As Integer
Click to expand...
    Debug.Print ThisWorkbook.Path
    FileName = "\\broner\data$\FCDM.dat"
Click to expand...
    FileNumber = FreeFile()
    Open FileName For Output As #FileNumber
Click to expand...
For Unit = 0 To 6 Step 2
Click to expand...
    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
Click to expand...
   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
Click to expand...
   Next sht
Next Unit
Click to expand...
ExitSub:
Close #FileNumber
Click to expand...
End Sub
Click to expand...
Private Function CreateCVS( _
    sh As Worksheet, _
    StartingDateRange As Range, _
    FileNumber As Integer, Unit As Integer) As Boolean
Click to expand...
    On Error GoTo Err_CreateCVS
Click to expand...
    Dim UnitNumber As String, CurrentDate As Date
    Dim DataRange As Range
Click to expand...
    Dim FirstColumn As Integer, LastColumn As Integer, _
       CurrentColumn As Integer
    Dim FirstColumn1 As Integer, LastColumn1 As Integer, _
       CurrentColumn1 As Integer
Click to expand...
    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
Click to expand...
    Dim i As Integer
Click to expand...
    'Data Range starts with first schedule box. Everything else is
    'offset according to this cell
Click to expand...
    Set DataRange = sh.Range(StartingDateRange.Offset(1), _
        StartingDateRange.End(xlToRight).Offset(3))
Click to expand...
        Debug.Print DataRange(1).Address
Click to expand...
    FirstColumn = DataRange(1).Column
    LastColumn = FirstColumn + DataRange.Columns.Count - 1
    ShiftRow = DataRange(1).Row
    UnitNumber = DataRange(1).Offset(, -2)
    CurrentDate = DateValue(StartingDateRange)
Click to expand...
        PreviousShiftStatus = "No Previous Status"
Click to expand...
        If UnitNumber <> "0" Then
             For CurrentColumn = FirstColumn To LastColumn
Click to expand...
                ShiftStatus(1) = sh.Cells(ShiftRow, CurrentColumn)
                ShiftStatus(2) = sh.Cells(ShiftRow + 1, CurrentColumn)
                ShiftStatus(3) = sh.Cells(ShiftRow + 2, CurrentColumn)
Click to expand...
                For ShiftItem = 1 To 3
Click to expand...
                    ConservationShutdown = False
Click to expand...
                    Select Case Trim(UCase(ShiftStatus(ShiftItem)))
                        Case "X", "O"
                            CurrentShiftStatus = "U"
                        Case "", "H"
                            CurrentShiftStatus = "D"
                        Case "E"
                            CurrentShiftStatus = "D"
                            ConservationShutdown = True
Click to expand...
                    End Select
Click to expand...
                    If PreviousShiftStatus <> CurrentShiftStatus Then
Click to expand...
                        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")
Click to expand...
                        End If
Click to expand...
                    PreviousShiftStatus = CurrentShiftStatus
                Next
Click to expand...
                CurrentDate = CurrentDate + 1
Click to expand...
            Next
Click to expand...
    CreateCVS = True
    Exit Function

End Function
Click to expand...
Naji said:
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!
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.
:
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 eachrow
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
Click to expand...
Click to expand...

...

read more »- Hide quoted text -

- Show quoted text -
Click to expand...
 
J

Joel

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.
 
N

Naji

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
 
J

Joel

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.
 
N

Naji

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
 
J

Joel

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
 
N

Naji

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?
 
N

Naji

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

Joel

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

For Next Variable Not Being Passed Through For Second Sheet 5
Help - Loop Function Giving Incorrect Output 4
Need Help With My Loop That Creates Output File 5
Figuring out loop for a production schedule 2
Need Help With Loop That Creates Output File 0
Set object with a function 3
returning an array from a function 3
Opeing PDF's withing a MAcro I have written 0

Top