| Home | Forums | Reviews | Articles | Register |
 |
| Thread Tools | Rate Thread |
|
Naji
Guest
Posts: n/a
|
Hello,
I am given the task of expanding an already existing macro, however I'm a bit novice I suppose and I am stuck with the program not working with the added changes, so I'm doing it wrong. I have simplified the code and functionality to better enable me to explain my problem and hopefully get some helpful feedback that won't confuse the reader. The macro's purpose is to read production turns for a unit and write them out into a comma delimited file to be used by production programs. It goes through a 3-row multiple column range where each row indicates a shift(morning/mid/night) and each column indicates a date. The macro's purpose is to detect changes from " " to "X" or from "X" to " " to indicate time frames when the machine is running as to when it's "down" and not. Once it goes through this range, it moves on to the next unit which has its turns listed below it, and so on. These planned up and down instructions are then fed into the machines themselves to instruct when they are on or off. Anyhow, currently the macro and spreadsheet is one single spreadsheet. I need to expand the workbook to 3 spreadsheets to extend the time frame further. So for each unit, after it's done with the first worksheet, it moves on to the second worksheet which is just a continuation of the first worksheet and basically a twin, with only the dates and turns different, and then a third. I just put in a change sheet command and copied and pasted the code three times to fufill the effect but it is not moving on to the second and third pages. The dates change forward accordingly, but it just copies the turns from the first spreadsheet twice instead of reading in from the second and then third. Please, I know this is a simple solution to a program that already exists...it's just I'm no expert and don't want to start this all over just because I don't understand the existing logic. Your help will make my day! I spent all day yesterday fretting over this... Sub ProcessRanges() On Error GoTo ExitSub Dim StartingDateRange As Range, FileName As String Dim FileNumber As Integer Set StartingDateRange = Sheet1.[c3] If Not IsDate(StartingDateRange) Then MsgBox "Invalid starting date in range " & StartingDateRange.Address(0, 0) Exit Sub End If Debug.Print ThisWorkbook.Path FileName = "\\broner\data$\FCDM.dat" FileNumber = FreeFile() Open FileName For Output As #FileNumber If CreateCVS(Sheets("FC1"), StartingDateRange, FileNumber) Then 'all is well Debug.Print "Success..." Else 'problem Debug.Print "Failure..." End If If CreateCVS(Sheets("FC2"), StartingDateRange, FileNumber) Then 'all is well Debug.Print "Success..." Else 'problem Debug.Print "Failure..." End If If CreateCVS(Sheets("FC3"), StartingDateRange, FileNumber) Then 'all is well Debug.Print "Success..." Else 'problem Debug.Print "Failure..." End If ExitSub: Close #FileNumber End Sub Private Function CreateCVS( _ sh As Worksheet, _ StartingDateRange As Range, _ FileNumber As Integer) As Boolean On Error GoTo Err_CreateCVS Dim UnitNumber As String, CurrentDate As Date Dim DataRange As Range Dim FirstColumn As Integer, LastColumn As Integer, CurrentColumn As Integer Dim FirstColumn1 As Integer, LastColumn1 As Integer, CurrentColumn1 As Integer Dim ShiftRow As Long, ShiftStatus(1 To 3) As String Dim ShiftItem As Integer Dim PreviousShiftStatus As String, CurrentShiftStatus As String Dim ConservationShutdown As Boolean Dim HalfDay As Boolean Dim i As Integer 'Data Range starts with first schedule box. Everything else is offset according to this cell Set DataRange = sh.Range(StartingDateRange.Offset(1), _ StartingDateRange.End(xlToRight).Offset(3)) Debug.Print DataRange(1).Address FirstColumn = DataRange(1).Column LastColumn = FirstColumn + DataRange.Columns.Count - 1 ShiftRow = DataRange(1).Row UnitNumber = DataRange(1).Offset(, -2) CurrentDate = DateValue(StartingDateRange) Do PreviousShiftStatus = "No Previous Status" If UnitNumber <> "0" Then For CurrentColumn = FirstColumn To LastColumn ShiftStatus(1) = sh.Cells(ShiftRow, CurrentColumn) ShiftStatus(2) = sh.Cells(ShiftRow + 1, CurrentColumn) ShiftStatus(3) = sh.Cells(ShiftRow + 2, CurrentColumn) For ShiftItem = 1 To 3 ConservationShutdown = False Select Case Trim(UCase(ShiftStatus(ShiftItem))) Case "X", "O" CurrentShiftStatus = "U" Case "", "H" CurrentShiftStatus = "D" Case "E" CurrentShiftStatus = "D" ConservationShutdown = True End Select If PreviousShiftStatus <> CurrentShiftStatus Then Print #FileNumber, UnitNumber & "," & CurrentShiftStatus & "," & _ Format(CurrentDate + Choose(ShiftItem, #12:00:00 AM#, #8:00:00 AM#, #4:00:00 PM#), _ "mm/dd/yyyy hh:mm") End If PreviousShiftStatus = CurrentShiftStatus Next CurrentDate = CurrentDate + 1 Next 'SECOND TAB STARTS HERE Sheets("FC2").Select For CurrentColumn = FirstColumn To LastColumn ShiftStatus(1) = sh.Cells(ShiftRow, CurrentColumn) ShiftStatus(2) = sh.Cells(ShiftRow + 1, CurrentColumn) ShiftStatus(3) = sh.Cells(ShiftRow + 2, CurrentColumn) For ShiftItem = 1 To 3 ConservationShutdown = False Select Case Trim(UCase(ShiftStatus(ShiftItem))) Case "X", "O" CurrentShiftStatus = "U" Case "", "H" CurrentShiftStatus = "D" Case "E" CurrentShiftStatus = "D" ConservationShutdown = True End Select If PreviousShiftStatus <> CurrentShiftStatus Then Print #FileNumber, UnitNumber & "," & CurrentShiftStatus & "," & _ Format(CurrentDate + Choose(ShiftItem, #12:00:00 AM#, #8:00:00 AM#, #4:00:00 PM#), _ "mm/dd/yyyy hh:mm") End If PreviousShiftStatus = CurrentShiftStatus Next CurrentDate = CurrentDate + 1 Next 'THIRD TAB STARTS HERE Sheets("FC3").Select For CurrentColumn = FirstColumn To LastColumn ShiftStatus(1) = sh.Cells(ShiftRow, CurrentColumn) ShiftStatus(2) = sh.Cells(ShiftRow + 1, CurrentColumn) ShiftStatus(3) = sh.Cells(ShiftRow + 2, CurrentColumn) For ShiftItem = 1 To 3 ConservationShutdown = False Select Case Trim(UCase(ShiftStatus(ShiftItem))) Case "X", "O" CurrentShiftStatus = "U" Case "", "H" CurrentShiftStatus = "D" Case "E" CurrentShiftStatus = "D" ConservationShutdown = True End Select If PreviousShiftStatus <> CurrentShiftStatus Then Print #FileNumber, UnitNumber & "," & CurrentShiftStatus & "," & _ Format(CurrentDate + Choose(ShiftItem, #12:00:00 AM#, #8:00:00 AM#, #4:00:00 PM#), _ "mm/dd/yyyy hh:mm") End If PreviousShiftStatus = CurrentShiftStatus Next CurrentDate = CurrentDate + 1 Next End If Set DataRange = DataRange.Offset(6) UnitNumber = DataRange(1).Offset(, -2) ShiftRow = DataRange(1).Row CurrentDate = StartingDateRange Loop Until Trim(UnitNumber) = "" CreateCVS = True Exit Function Err_CreateCVS: End Function |
|
||
|
||||
|
|
|
| |
|
Joel
Guest
Posts: n/a
|
You don't need to modify CreateCVS function. The variable sh is passed to
the function which is the worksheet. You already modified the Sub ProcessRanges() to call CreateCVS three times with a differrent worksheet name each time. Private Function CreateCVS( _ sh As Worksheet, _ StartingDateRange As Range, _ FileNumber As Integer) As Boolean The line Sheets("FC2").Select does nothing in the code because the code is using the variable sh to select the appropriate sheets. "Naji" wrote: > Hello, > > I am given the task of expanding an already existing macro, however > I'm a bit novice I suppose and I am stuck with the program not working > with the added changes, so I'm doing it wrong. I have simplified the > code and functionality to better enable me to explain my problem and > hopefully get some helpful feedback that won't confuse the reader. > > The macro's purpose is to read production turns for a unit and write > them out into a comma delimited file to be used by production > programs. It goes through a 3-row multiple column range where each row > indicates a shift(morning/mid/night) and each column indicates a date. > The macro's purpose is to detect changes from " " to "X" or from "X" > to " " to indicate time frames when the machine is running as to when > it's "down" and not. Once it goes through this range, it moves on to > the next unit which has its turns listed below it, and so on. These > planned up and down instructions are then fed into the machines > themselves to instruct when they are on or off. > > Anyhow, currently the macro and spreadsheet is one single spreadsheet. > I need to expand the workbook to 3 spreadsheets to extend the time > frame further. So for each unit, after it's done with the first > worksheet, it moves on to the second worksheet which is just a > continuation of the first worksheet and basically a twin, with only > the dates and turns different, and then a third. > > I just put in a change sheet command and copied and pasted the code > three times to fufill the effect but it is not moving on to the second > and third pages. The dates change forward accordingly, but it just > copies the turns from the first spreadsheet twice instead of reading > in from the second and then third. Please, I know this is a simple > solution to a program that already exists...it's just I'm no expert > and don't want to start this all over just because I don't understand > the existing logic. Your help will make my day! I spent all day > yesterday fretting over this... > > > Sub ProcessRanges() > On Error GoTo ExitSub > Dim StartingDateRange As Range, FileName As String > Dim FileNumber As Integer > > Set StartingDateRange = Sheet1.[c3] > If Not IsDate(StartingDateRange) Then > MsgBox "Invalid starting date in range " & > StartingDateRange.Address(0, 0) > Exit Sub > End If > > Debug.Print ThisWorkbook.Path > FileName = "\\broner\data$\FCDM.dat" > > FileNumber = FreeFile() > Open FileName For Output As #FileNumber > > If CreateCVS(Sheets("FC1"), StartingDateRange, FileNumber) Then > 'all is well > Debug.Print "Success..." > Else > 'problem > Debug.Print "Failure..." > End If > > If CreateCVS(Sheets("FC2"), StartingDateRange, FileNumber) Then > 'all is well > Debug.Print "Success..." > Else > 'problem > Debug.Print "Failure..." > End If > > If CreateCVS(Sheets("FC3"), StartingDateRange, FileNumber) Then > 'all is well > Debug.Print "Success..." > Else > 'problem > Debug.Print "Failure..." > End If > > > ExitSub: > Close #FileNumber > > > End Sub > > Private Function CreateCVS( _ > sh As Worksheet, _ > StartingDateRange As Range, _ > FileNumber As Integer) As Boolean > > On Error GoTo Err_CreateCVS > > Dim UnitNumber As String, CurrentDate As Date > Dim DataRange As Range > > Dim FirstColumn As Integer, LastColumn As Integer, CurrentColumn > As Integer > Dim FirstColumn1 As Integer, LastColumn1 As Integer, > CurrentColumn1 As Integer > > Dim ShiftRow As Long, ShiftStatus(1 To 3) As String > Dim ShiftItem As Integer > Dim PreviousShiftStatus As String, CurrentShiftStatus As String > Dim ConservationShutdown As Boolean > Dim HalfDay As Boolean > > Dim i As Integer > > 'Data Range starts with first schedule box. Everything else is > offset according to this cell > > > Set DataRange = sh.Range(StartingDateRange.Offset(1), _ > StartingDateRange.End(xlToRight).Offset(3)) > > Debug.Print DataRange(1).Address > > FirstColumn = DataRange(1).Column > LastColumn = FirstColumn + DataRange.Columns.Count - 1 > ShiftRow = DataRange(1).Row > UnitNumber = DataRange(1).Offset(, -2) > CurrentDate = DateValue(StartingDateRange) > > Do > > PreviousShiftStatus = "No Previous Status" > > If UnitNumber <> "0" Then > For CurrentColumn = FirstColumn To LastColumn > > ShiftStatus(1) = sh.Cells(ShiftRow, CurrentColumn) > ShiftStatus(2) = sh.Cells(ShiftRow + 1, CurrentColumn) > ShiftStatus(3) = sh.Cells(ShiftRow + 2, CurrentColumn) > > > > For ShiftItem = 1 To 3 > > ConservationShutdown = False > > > > Select Case Trim(UCase(ShiftStatus(ShiftItem))) > Case "X", "O" > CurrentShiftStatus = "U" > Case "", "H" > CurrentShiftStatus = "D" > Case "E" > CurrentShiftStatus = "D" > ConservationShutdown = True > > > End Select > > > If PreviousShiftStatus <> CurrentShiftStatus > Then > > Print #FileNumber, UnitNumber & > "," & CurrentShiftStatus & "," & _ > Format(CurrentDate + > Choose(ShiftItem, #12:00:00 AM#, #8:00:00 AM#, #4:00:00 PM#), _ > "mm/dd/yyyy hh:mm") > > > > > End If > > PreviousShiftStatus = CurrentShiftStatus > Next > > CurrentDate = CurrentDate + 1 > > > Next > > > 'SECOND TAB STARTS HERE > > Sheets("FC2").Select > > For CurrentColumn = FirstColumn To LastColumn > > ShiftStatus(1) = sh.Cells(ShiftRow, CurrentColumn) > ShiftStatus(2) = sh.Cells(ShiftRow + 1, CurrentColumn) > ShiftStatus(3) = sh.Cells(ShiftRow + 2, CurrentColumn) > > > > For ShiftItem = 1 To 3 > > ConservationShutdown = False > > > > Select Case Trim(UCase(ShiftStatus(ShiftItem))) > Case "X", "O" > CurrentShiftStatus = "U" > Case "", "H" > CurrentShiftStatus = "D" > Case "E" > CurrentShiftStatus = "D" > ConservationShutdown = True > > > End Select > > > If PreviousShiftStatus <> CurrentShiftStatus > Then > > Print #FileNumber, UnitNumber & > "," & CurrentShiftStatus & "," & _ > Format(CurrentDate + > Choose(ShiftItem, #12:00:00 AM#, #8:00:00 AM#, #4:00:00 PM#), _ > "mm/dd/yyyy hh:mm") > > > > > End If > > PreviousShiftStatus = CurrentShiftStatus > Next > > CurrentDate = CurrentDate + 1 > > > Next > > 'THIRD TAB STARTS HERE > > Sheets("FC3").Select > > For CurrentColumn = FirstColumn To LastColumn > > ShiftStatus(1) = sh.Cells(ShiftRow, CurrentColumn) > ShiftStatus(2) = sh.Cells(ShiftRow + 1, CurrentColumn) > ShiftStatus(3) = sh.Cells(ShiftRow + 2, CurrentColumn) > > > > For ShiftItem = 1 To 3 > > ConservationShutdown = False > > > > Select Case Trim(UCase(ShiftStatus(ShiftItem))) > Case "X", "O" > CurrentShiftStatus = "U" > Case "", "H" > CurrentShiftStatus = "D" > Case "E" > CurrentShiftStatus = "D" > ConservationShutdown = True > > > End Select > > > If PreviousShiftStatus <> CurrentShiftStatus > Then > > Print #FileNumber, UnitNumber & > "," & CurrentShiftStatus & "," & _ > Format(CurrentDate + > Choose(ShiftItem, #12:00:00 AM#, #8:00:00 AM#, #4:00:00 PM#), _ > "mm/dd/yyyy hh:mm") > > > > > End If > > PreviousShiftStatus = CurrentShiftStatus > Next > > CurrentDate = CurrentDate + 1 > > > Next > > End If > > Set DataRange = DataRange.Offset(6) > UnitNumber = DataRange(1).Offset(, -2) > ShiftRow = DataRange(1).Row > CurrentDate = StartingDateRange > > > Loop Until Trim(UnitNumber) = "" > > CreateCVS = True > Exit Function > > Err_CreateCVS: > |
|
||
|
|
||||
|
Naji
Guest
Posts: n/a
|
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 <J...@discussions.microsoft.com> wrote: > You don't need to modify CreateCVS function. *The variable sh is passed to > the function which is the worksheet. *You already modified the Sub > ProcessRanges() to call CreateCVS three times with a differrent worksheet > name each time. > > Private Function CreateCVS( _ > * * sh As Worksheet, _ > * * StartingDateRange As Range, _ > * * FileNumber As Integer) As Boolean > > The line Sheets("FC2").Select > does nothing in the code because the code is using the variable sh to select > the appropriate sheets. > > > > "Naji" wrote: > > Hello, > > > I am given the task of expanding an already existing macro, however > > I'm a bit novice I suppose and I am stuck with the program not working > > with the added changes, so I'm doing it wrong. I have simplified the > > code and functionality to better enable me to explain my problem and > > hopefully get some helpful feedback that won't confuse the reader. > > > The macro's purpose is to read production turns for a unit and write > > them out into a comma delimited file to be used by production > > programs. It goes through a 3-row multiple column range where each row > > indicates a shift(morning/mid/night) and each column indicates a date. > > The macro's purpose is to detect changes from " " to "X" or from "X" > > to " " to indicate time frames when the machine is running as to when > > it's "down" and not. Once it goes through this range, it moves on to > > the next unit which has its turns listed below it, and so on. These > > planned up and down instructions are then fed into the machines > > themselves to instruct when they are on or off. > > > Anyhow, currently the macro and spreadsheet is one single spreadsheet. > > I need to expand the workbook to 3 spreadsheets to extend the time > > frame further. So for each unit, after it's done with the first > > worksheet, it moves on to the second worksheet which is just a > > continuation of the first worksheet and basically a twin, with only > > the dates and turns different, and then a third. > > > I just put in a change sheet command and copied and pasted the code > > three times to fufill the effect but it is not moving on to the second > > and third pages. The dates change forward accordingly, but it just > > copies the turns from the first spreadsheet twice instead of reading > > in from the second and then third. Please, I know this is a simple > > solution to a program that already exists...it's just I'm no expert > > and don't want to start this all over just because I don't understand > > the existing logic. Your help will make my day! I spent all day > > yesterday fretting over this... > > > Sub ProcessRanges() > > * * On Error GoTo ExitSub > > * * Dim StartingDateRange As Range, FileName As String > > * * Dim FileNumber As Integer > > > * * Set StartingDateRange = Sheet1.[c3] > > * * If Not IsDate(StartingDateRange) Then > > * * * * MsgBox "Invalid starting date in range " & > > StartingDateRange.Address(0, 0) > > * * * * Exit Sub > > * * End If > > > * * Debug.Print ThisWorkbook.Path > > * * FileName = "\\broner\data$\FCDM.dat" > > > * * FileNumber = FreeFile() > > * * Open FileName For Output As #FileNumber > > > * * If CreateCVS(Sheets("FC1"), StartingDateRange, FileNumber) Then > > * * * * 'all is well > > * * * * Debug.Print "Success..." > > * * Else > > * * * * 'problem > > * * * * Debug.Print "Failure..." > > * * End If > > > * * If CreateCVS(Sheets("FC2"), StartingDateRange, FileNumber) Then > > * * * * 'all is well > > * * * * Debug.Print "Success..." > > * * Else > > * * * * 'problem > > * * * * Debug.Print "Failure..." > > * * End If > > > * * If CreateCVS(Sheets("FC3"), StartingDateRange, FileNumber) Then > > * * * * 'all is well > > * * * * Debug.Print "Success..." > > * * Else > > * * * * 'problem > > * * * * Debug.Print "Failure..." > > * * End If > > > ExitSub: > > Close #FileNumber > > > End Sub > > > Private Function CreateCVS( _ > > * * sh As Worksheet, _ > > * * StartingDateRange As Range, _ > > * * FileNumber As Integer) As Boolean > > > * * On Error GoTo Err_CreateCVS > > > * * Dim UnitNumber As String, CurrentDate As Date > > * * Dim DataRange As Range > > > * * Dim FirstColumn As Integer, LastColumn As Integer, CurrentColumn > > As Integer > > * * Dim FirstColumn1 As Integer, LastColumn1 As Integer, > > CurrentColumn1 As Integer > > > * * Dim ShiftRow As Long, ShiftStatus(1 To 3) As String > > * * Dim ShiftItem As Integer > > * * Dim PreviousShiftStatus As String, CurrentShiftStatus As String > > * * Dim ConservationShutdown As Boolean > > * * Dim HalfDay As Boolean > > > * * Dim i As Integer > > > * * 'Data Range starts with first schedule box. Everything else is > > offset according to this cell > > > * * Set DataRange = sh.Range(StartingDateRange.Offset(1), _ > > * * * * StartingDateRange.End(xlToRight).Offset(3)) > > > * * * * Debug.Print DataRange(1).Address > > > * * FirstColumn = DataRange(1).Column > > * * LastColumn = FirstColumn + DataRange.Columns.Count - 1 > > * * ShiftRow = DataRange(1).Row > > * * UnitNumber = DataRange(1).Offset(, -2) > > * * CurrentDate = DateValue(StartingDateRange) > > > * * Do > > > * * * * PreviousShiftStatus = "No Previous Status" > > > * * * * If UnitNumber <> "0" Then > > * * * * * * *For CurrentColumn = FirstColumn To LastColumn > > > * * * * * * * * ShiftStatus(1) = sh.Cells(ShiftRow, CurrentColumn) > > * * * * * * * * ShiftStatus(2) = sh.Cells(ShiftRow + 1, CurrentColumn) > > * * * * * * * * ShiftStatus(3) = sh.Cells(ShiftRow + 2, CurrentColumn) > > > * * * * * * * * For ShiftItem = 1 To 3 > > > * * * * * * * * * * ConservationShutdown = False > > > * * * * * * * * * * Select Case Trim(UCase(ShiftStatus(ShiftItem))) > > * * * * * * * * * * * * Case "X", "O" > > * * * * * * * * * * * * * * CurrentShiftStatus = "U" > > * * * * * * * * * * * * Case "", "H" > > * * * * * * * * * * * * * * CurrentShiftStatus = "D" > > * * * * * * * * * * * * Case "E" > > * * * * * * * * * * * * * * CurrentShiftStatus = "D" > > * * * * * * * * * * * * * * ConservationShutdown = True > > > * * * * * * * * * * End Select > > > * * * * * * * * * * * * If PreviousShiftStatus <> CurrentShiftStatus > > Then > > > * * * * * * * * * * * * * * * * * * Print #FileNumber, UnitNumber & > > "," & CurrentShiftStatus & "," & _ > > * * * * * * * * * * * * * * * * * * Format(CurrentDate + > > Choose(ShiftItem, #12:00:00 AM#, #8:00:00 AM#, #4:00:00 PM#), _ > > * * * * * * * * * * * * * * * * * * "mm/dd/yyyy hh:mm") > > > * * * * * * * * * * * * End If > > > * * * * * * * * * * PreviousShiftStatus = CurrentShiftStatus > > * * * * * * * * Next > > > * * * * * * * * CurrentDate = CurrentDate + 1 > > > * * * * * * Next > > > > * * * * End If > > > * * * * Set DataRange = DataRange.Offset(6) > > * * * * UnitNumber = DataRange(1).Offset(, -2) > > * * * * ShiftRow = DataRange(1).Row > > * * * * CurrentDate = StartingDateRange > > > * * Loop Until Trim(UnitNumber) = "" > > > * * CreateCVS = True > > * * Exit Function > > > Err_CreateCVS:- Hide quoted text - > > - Show quoted text - |
|
||
|
|
||||
|
Joel
Guest
Posts: n/a
|
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 <J...@discussions.microsoft.com> wrote: > > You don't need to modify CreateCVS function. The variable sh is passed to > > the function which is the worksheet. You already modified the Sub > > ProcessRanges() to call CreateCVS three times with a differrent worksheet > > name each time. > > > > Private Function CreateCVS( _ > > sh As Worksheet, _ > > StartingDateRange As Range, _ > > FileNumber As Integer) As Boolean > > > > The line Sheets("FC2").Select > > does nothing in the code because the code is using the variable sh to select > > the appropriate sheets. > > > > > > > > "Naji" wrote: > > > Hello, > > > > > I am given the task of expanding an already existing macro, however > > > I'm a bit novice I suppose and I am stuck with the program not working > > > with the added changes, so I'm doing it wrong. I have simplified the > > > code and functionality to better enable me to explain my problem and > > > hopefully get some helpful feedback that won't confuse the reader. > > > > > The macro's purpose is to read production turns for a unit and write > > > them out into a comma delimited file to be used by production > > > programs. It goes through a 3-row multiple column range where each row > > > indicates a shift(morning/mid/night) and each column indicates a date. > > > The macro's purpose is to detect changes from " " to "X" or from "X" > > > to " " to indicate time frames when the machine is running as to when > > > it's "down" and not. Once it goes through this range, it moves on to > > > the next unit which has its turns listed below it, and so on. These > > > planned up and down instructions are then fed into the machines > > > themselves to instruct when they are on or off. > > > > > Anyhow, currently the macro and spreadsheet is one single spreadsheet. > > > I need to expand the workbook to 3 spreadsheets to extend the time > > > frame further. So for each unit, after it's done with the first > > > worksheet, it moves on to the second worksheet which is just a > > > continuation of the first worksheet and basically a twin, with only > > > the dates and turns different, and then a third. > > > > > I just put in a change sheet command and copied and pasted the code > > > three times to fufill the effect but it is not moving on to the second > > > and third pages. The dates change forward accordingly, but it just > > > copies the turns from the first spreadsheet twice instead of reading > > > in from the second and then third. Please, I know this is a simple > > > solution to a program that already exists...it's just I'm no expert > > > and don't want to start this all over just because I don't understand > > > the existing logic. Your help will make my day! I spent all day > > > yesterday fretting over this... > > > > > Sub ProcessRanges() > > > On Error GoTo ExitSub > > > Dim StartingDateRange As Range, FileName As String > > > Dim FileNumber As Integer > > > > > Set StartingDateRange = Sheet1.[c3] > > > If Not IsDate(StartingDateRange) Then > > > MsgBox "Invalid starting date in range " & > > > StartingDateRange.Address(0, 0) > > > Exit Sub > > > End If > > > > > Debug.Print ThisWorkbook.Path > > > FileName = "\\broner\data$\FCDM.dat" > > > > > FileNumber = FreeFile() > > > Open FileName For Output As #FileNumber > > > > > If CreateCVS(Sheets("FC1"), StartingDateRange, FileNumber) Then > > > 'all is well > > > Debug.Print "Success..." > > > Else > > > 'problem > > > Debug.Print "Failure..." > > > End If > > > > > If CreateCVS(Sheets("FC2"), StartingDateRange, FileNumber) Then > > > 'all is well > > > Debug.Print "Success..." > > > Else > > > 'problem > > > Debug.Print "Failure..." > > > End If > > > > > If CreateCVS(Sheets("FC3"), StartingDateRange, FileNumber) Then > > > 'all is well > > > Debug.Print "Success..." > > > Else > > > 'problem > > > Debug.Print "Failure..." > > > End If > > > > > ExitSub: > > > Close #FileNumber > > > > > End Sub > > > > > Private Function CreateCVS( _ > > > sh As Worksheet, _ > > > StartingDateRange As Range, _ > > > FileNumber As Integer) As Boolean > > > > > On Error GoTo Err_CreateCVS > > > > > Dim UnitNumber As String, CurrentDate As Date > > > Dim DataRange As Range > > > > > Dim FirstColumn As Integer, LastColumn As Integer, CurrentColumn > > > As Integer > > > Dim FirstColumn1 As Integer, LastColumn1 As Integer, > > > CurrentColumn1 As Integer > > > > > Dim ShiftRow As Long, ShiftStatus(1 To 3) As String > > > Dim ShiftItem As Integer > > > Dim PreviousShiftStatus As String, CurrentShiftStatus As String > > > Dim ConservationShutdown As Boolean > > > Dim HalfDay As Boolean > > > > > Dim i As Integer > > > > > 'Data Range starts with first schedule box. Everything else is > > > offset according to this cell > > > > > Set DataRange = sh.Range(StartingDateRange.Offset(1), _ > > > StartingDateRange.End(xlToRight).Offset(3)) > > > > > Debug.Print DataRange(1).Address > > > > > FirstColumn = DataRange(1).Column > > > LastColumn = FirstColumn + DataRange.Columns.Count - 1 > > > ShiftRow = DataRange(1).Row > > > UnitNumber = DataRange(1).Offset(, -2) > > > CurrentDate = DateValue(StartingDateRange) > > > > > Do > > > > > PreviousShiftStatus = "No Previous Status" > > > > > If UnitNumber <> "0" Then > > > For CurrentColumn = FirstColumn To LastColumn > > > > > ShiftStatus(1) = sh.Cells(ShiftRow, CurrentColumn) > > > ShiftStatus(2) = sh.Cells(ShiftRow + 1, CurrentColumn) > > > ShiftStatus(3) = sh.Cells(ShiftRow + 2, CurrentColumn) > > > > > For ShiftItem = 1 To 3 > > > > > ConservationShutdown = False > > > > > Select Case Trim(UCase(ShiftStatus(ShiftItem))) > > > Case "X", "O" > > > CurrentShiftStatus = "U" > > > Case "", "H" > > > CurrentShiftStatus = "D" > > > Case "E" > > > CurrentShiftStatus = "D" > > > ConservationShutdown = True > > > > > End Select > > > > > If PreviousShiftStatus <> CurrentShiftStatus > > > Then > > > > > Print #FileNumber, UnitNumber & > > > "," & CurrentShiftStatus & "," & _ > > > Format(CurrentDate + > > > Choose(ShiftItem, #12:00:00 AM#, #8:00:00 AM#, #4:00:00 PM#), _ > > > "mm/dd/yyyy hh:mm") > > > > > End If > > > > > PreviousShiftStatus = CurrentShiftStatus > > > Next > > > > > CurrentDate = CurrentDate + 1 > > > > > Next > > > > > > > End If > > > > > Set DataRange = DataRange.Offset(6) > > > UnitNumber = DataRange(1).Offset(, -2) > > > ShiftRow = DataRange(1).Row > > > CurrentDate = StartingDateRange > > > > > Loop Until Trim(UnitNumber) = "" > > > > > CreateCVS = True > > > Exit Function > > > > > Err_CreateCVS:- Hide quoted text - > > > > - Show quoted text - > > |
|
||
|
|
||||
|
Naji
Guest
Posts: n/a
|
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 <J...@discussions.microsoft.com> 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 <J...@discussions.microsoft.com> 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) > > ... > > read more »- Hide quoted text - > > - Show quoted text - |
|
||
|
|
||||
|
Naji
Guest
Posts: n/a
|
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 <connected...@aol.com> 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 <J...@discussions.microsoft.com> 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 <J...@discussions.microsoft.com> 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 eachrow > > > > > indicates a shift(morning/mid/night) and each column indicates a date. > > > > > The macro's purpose is to detect changes from " " to "X" or from "X" > > > > > to " " to indicate time frames when the machine is running as to when > > > > > it's "down" and not. Once it goes through this range, it moves on to > > > > > the next unit which has its turns listed below it, and so on. These > > > > > planned up and down instructions are then fed into the machines > > > > > themselves to instruct when they are on or off. > > > > > > Anyhow, currently the macro and spreadsheet is one single spreadsheet. > > > > > I need to expand the workbook to 3 spreadsheets to extend the time > > > > > frame further. So for each unit, after it's done with the first > > > > > worksheet, it moves on to the second worksheet which is just a > > > > > continuation of the first worksheet and basically a twin, with only > > > > > the dates and turns different, and then a third. > > > > > > I just put in a change sheet command and copied and pasted the code > > > > > three times to fufill the effect but it is not moving on to the second > > > > > and third pages. The dates change forward accordingly, but it just > > > > > copies the turns from the first spreadsheet twice instead of reading > > > > > in from the second and then third. Please, I know this is a simple > > > > > solution to a program that already exists...it's just I'm no expert > > > > > and don't want to start this all over just because I don't understand > > > > > the existing logic. Your help will make my day! I spent all day > > > > > yesterday fretting over this... > > > > > > Sub ProcessRanges() > > > > > * * On Error GoTo ExitSub > > > > > * * Dim StartingDateRange As Range, FileName As String > > > > > * * Dim FileNumber As Integer > > > > > > * * Set StartingDateRange = Sheet1.[c3] > > > > > * * If Not IsDate(StartingDateRange) Then > > > > > * * * * MsgBox "Invalid starting date in range " & > > > > > StartingDateRange.Address(0, 0) > > > > > * * * * Exit Sub > > > > > * * End If > > > > > > * * Debug.Print ThisWorkbook.Path > > ... > > read more »- Hide quoted text - > > - Show quoted text - |
|
||
|
|
||||
|
Joel
Guest
Posts: n/a
|
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 <connected...@aol.com> 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 <J...@discussions.microsoft.com> 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 <J...@discussions.microsoft.com> wrote: > > > > > You don't need to modify CreateCVS function. The variable sh is passed to |
|
||
|
|
||||
|
Naji
Guest
Posts: n/a
|
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 <J...@discussions.microsoft.com> 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 pm,Naji<connected...@aol.com> 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 <J...@discussions.microsoft.com> 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 sheetone > > > > > 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 <J...@discussions.microsoft.com> wrote: > > > > > > You don't need to modify CreateCVS function. *The variable sh is passed to- Hide quoted text - > > - Show quoted text - |
|
||
|
|
||||
|
Joel
Guest
Posts: n/a
|
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 <J...@discussions.microsoft.com> wrote: > > change 2 to 3 > > from > > For Unit = 0 To 6 Step 2 > > to > > For Unit = 0 To 6 Step 3 > > > > from your original posting you said the following > > where each row indicates a shift(morning/mid/night) and each column > > indicates a date. > > > > It looks like each item consits of 3 rows. The StartingDateRange date is in > > colum > > C. I was trying to move down the worksheet and set a new StartingDateRange > > for each item. It seems you code keys on the StartingDateRange. To get get > > the next item the StartingDateRange must be changed. > > > > Your code should set the StartingDateRange and then call the funcxttion > > CreateCVS 3 times (once for each sheet). Then change the StartingDateRange > > and again call the CreateCVS function 3 times. > > > > if you noticed I removed the do loop from inside the CreateCVS function and > > tried to add the same looping into the Sub ProcessRanges(). I did this > > because you didn't want the UnitNumber to increase until all 3 sheets were > > processed. > > > > > > > > "Naji" wrote: > > > Actually, I had to make one more change. I don't understand your > > > intended purpose for "For Unit 0 to 6 Step 2" Line. I think you meant > > > to fufill what i asked for but it did not work. I changed it to this > > > but now I still have the problem of the macro doing it sheet by sheet > > > instead of unit by unit. There are multiple units listed on each > > > sheet. > > > > > Sub ProcessRanges() > > > On Error GoTo ExitSub > > > Dim StartingDateRange1 As Range, StartingDateRange2 As Range, > > > StartingDateRange3 As Range, FileName As String > > > > > Dim FileNumber As Integer > > > > > Debug.Print ThisWorkbook.Path > > > FileName = "\\broner\data$\FCDM.dat" > > > > > FileNumber = FreeFile() > > > Open FileName For Output As #FileNumber > > > > > For Unit = 0 To 6 Step 2 > > > > > Set StartingDateRange1 = Sheet1.Range("C3") > > > Set StartingDateRange2 = Sheet2.Range("C3") > > > Set StartingDateRange3 = Sheet3.Range("C3") > > > > > For sht = 1 To 1 > > > If CreateCVS(Sheets("FC" & sht), StartingDateRange1, > > > FileNumber) Then > > > 'all is well > > > Debug.Print "Success..." > > > Else |
|
||
|
|
||||
|
Naji
Guest
Posts: n/a
|
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 <J...@discussions.microsoft.com> 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 <J...@discussions.microsoft.com> 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 - |
|
||
|
|
||||
|
|
|
| |
|
| Thread Tools | |
| Rate This Thread | |
|
|
Similar Threads
|
||||
| Thread | Thread Starter | Forum | Replies | Last Post |
| Macro to read and write data to multiple sheets | vvraj | Microsoft Excel Programming | 1 | 2nd May 2006 10:09 AM |
| How can I change a doc from read only to write? | =?Utf-8?B?YWxt?= | Microsoft Word Document Management | 1 | 8th Jul 2005 06:02 PM |
| Can't change the status of a folder from read only to read-write | =?Utf-8?B?Um9iaW4=?= | Windows XP General | 1 | 19th Oct 2004 03:12 AM |
| How to change debugging mode from read only to read/write | =?Utf-8?B?UmF5?= | Microsoft Dot NET Framework | 4 | 28th Sep 2004 08:52 PM |
| How do i change my read/write permission | =?Utf-8?B?TWljaGFlbA==?= | Windows XP Help | 0 | 6th Apr 2004 01:01 PM |
Powered by vBulletin®. Copyright ©2000 - 2012, Jelsoft Enterprises Ltd.
SEO by vBSEO ©2010, Crawlability, Inc. |
