Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
#2
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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: |
#3
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 - |
#4
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 - |
#5
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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. |
#6
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 - |
#7
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
#8
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 - |
#9
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
#10
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 - |
#11
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
#12
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 - |
#13
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 - |
#14
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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" |
#15
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
Thank You Very Much For your kind help! It helped tremendously!
|
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Need to write function that will change column width based on a condition | Excel Discussion (Misc queries) | |||
I have a read only xl file, I need it to be read and write | Excel Discussion (Misc queries) | |||
Macro to read and write data to multiple sheets | Excel Programming | |||
How can a file be converted from Read-Only to Read/Write | Excel Discussion (Misc queries) | |||
How to read a SQL Table into Excel change the data and write back into SQL | Excel Programming |