|
Code is great, except for one thing ...
This works great except it will stop if in the list the office is not found.
Sheet 1 contains all the offices and sheet2 contains all the information and list of offices and orders (not all offices orders). I need to email back a list of the orders to the offices, but this code stops completely if while it runs, a particular office is not found. For example: If this is my list on Sheet 1 Chicago Atlanta Orlando Detroit And sheet 2 has Chicago and Detroit listed, Orlando and Detroit will never get there spreadsheets separated because Atlanta was not in the mix ... I need this code to overlook that missing office and move along! ================ Sub SeparatetoPrepareForEmailing() Dim iRow, endRow As Integer Worksheets("Sheet1").Select Range("A1").Select 'For each office listed in Sheet1 copy the orders listed in Sheet2 endRow = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row For iRow = 1 To endRow Worksheets("Sheet1").Select Call copyOrders(Cells(iRow, 1).Value, "Sheet2") Next End Sub Sub copyOrders(office As String, ordersSheet As String) Dim officeSheet Dim ordersRange As Range Static iRow As Integer 'Retain row number where office search ended Dim lastOrdersRow, startRow, endRow As Long Sheets(ordersSheet).Select Range("A1").Select 'Look through the orders sheet and determine the start and end rows for the orders relating to 'the current office. This allows us to copy and paste the block of orders in one operation 'instead of individually. startRow = 0 endRow = 0 iRow = iRow + 1 lastOrdersRow = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row While iRow <= lastOrdersRow + 1 And endRow = 0 If Cells(iRow, 1) = office And startRow = 0 Then startRow = iRow ElseIf Cells(iRow, 1) < office And startRow < 0 Then endRow = iRow - 1 Else iRow = iRow + 1 End If Wend iRow = iRow - 1 'If there are any orders for this office If endRow < 0 Then 'Create a new worksheet if it doesn't exist If worksheetExists(office) Then Set officeSheet = Sheets(office) Else Set officeSheet = Sheets.Add officeSheet.name = office 'Name sheet as the office End If 'Copy the office name and related orders to the office sheet. 'This assumes that the office name is in column A, and the orders are in column B Sheets(ordersSheet).Select Set ordersRange = Range(Cells(startRow, 1), Cells(endRow, 2)) ordersRange.Select Selection.Copy Sheets(office).Select ActiveSheet.Paste Application.CutCopyMode = False End If End Sub Function worksheetExists(WSName As String, Optional WB As Workbook) As Boolean On Error Resume Next worksheetExists = CBool(Len(IIf(WB Is Nothing, ActiveWorkbook, WB).Worksheets(WSName).name)) End Function |
Code is great, except for one thing ...
|
Code is great, except for one thing ...
Where would I put that in the code
and just to make sure I'm being understood, the code doesn't error out, it just stops running as though it has completed the task. "Don Guillett" wrote in message ... Have a look at onerror then resume next -- Don Guillett SalesAid Software "Annette" wrote in message ... This works great except it will stop if in the list the office is not found. Sheet 1 contains all the offices and sheet2 contains all the information and list of offices and orders (not all offices orders). I need to email back a list of the orders to the offices, but this code stops completely if while it runs, a particular office is not found. For example: If this is my list on Sheet 1 Chicago Atlanta Orlando Detroit And sheet 2 has Chicago and Detroit listed, Orlando and Detroit will never get there spreadsheets separated because Atlanta was not in the mix ... I need this code to overlook that missing office and move along! ================ Sub SeparatetoPrepareForEmailing() Dim iRow, endRow As Integer Worksheets("Sheet1").Select Range("A1").Select 'For each office listed in Sheet1 copy the orders listed in Sheet2 endRow = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row For iRow = 1 To endRow Worksheets("Sheet1").Select Call copyOrders(Cells(iRow, 1).Value, "Sheet2") Next End Sub Sub copyOrders(office As String, ordersSheet As String) Dim officeSheet Dim ordersRange As Range Static iRow As Integer 'Retain row number where office search ended Dim lastOrdersRow, startRow, endRow As Long Sheets(ordersSheet).Select Range("A1").Select 'Look through the orders sheet and determine the start and end rows for the orders relating to 'the current office. This allows us to copy and paste the block of orders in one operation 'instead of individually. startRow = 0 endRow = 0 iRow = iRow + 1 lastOrdersRow = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row While iRow <= lastOrdersRow + 1 And endRow = 0 If Cells(iRow, 1) = office And startRow = 0 Then startRow = iRow ElseIf Cells(iRow, 1) < office And startRow < 0 Then endRow = iRow - 1 Else iRow = iRow + 1 End If Wend iRow = iRow - 1 'If there are any orders for this office If endRow < 0 Then 'Create a new worksheet if it doesn't exist If worksheetExists(office) Then Set officeSheet = Sheets(office) Else Set officeSheet = Sheets.Add officeSheet.name = office 'Name sheet as the office End If 'Copy the office name and related orders to the office sheet. 'This assumes that the office name is in column A, and the orders are in column B Sheets(ordersSheet).Select Set ordersRange = Range(Cells(startRow, 1), Cells(endRow, 2)) ordersRange.Select Selection.Copy Sheets(office).Select ActiveSheet.Paste Application.CutCopyMode = False End If End Sub Function worksheetExists(WSName As String, Optional WB As Workbook) As Boolean On Error Resume Next worksheetExists = CBool(Len(IIf(WB Is Nothing, ActiveWorkbook, WB).Worksheets(WSName).name)) End Function |
Code is great, except for one thing ...
Annette - I'm not an expert on this by any means, but my first thought is
that the way your code is getting the last row of the list might be ignoring blanks. In other words, if you have the four cells that would contain the list of offices, but the second one is blank, your code might be stopping at the first one and thinking that is the last row. Try putting MsgBox "My last row is " & endRow right after endRow= etc. and see what it's picking up. If this is the case, you might try making your list of offices a named range, then calling For Each iRow in that range. An If cell is not blank Then do stuff might help, too. 1.5 cents worth. Ed "Annette" wrote in message ... Where would I put that in the code and just to make sure I'm being understood, the code doesn't error out, it just stops running as though it has completed the task. "Don Guillett" wrote in message ... Have a look at onerror then resume next -- Don Guillett SalesAid Software "Annette" wrote in message ... This works great except it will stop if in the list the office is not found. Sheet 1 contains all the offices and sheet2 contains all the information and list of offices and orders (not all offices orders). I need to email back a list of the orders to the offices, but this code stops completely if while it runs, a particular office is not found. For example: If this is my list on Sheet 1 Chicago Atlanta Orlando Detroit And sheet 2 has Chicago and Detroit listed, Orlando and Detroit will never get there spreadsheets separated because Atlanta was not in the mix .... I need this code to overlook that missing office and move along! ================ Sub SeparatetoPrepareForEmailing() Dim iRow, endRow As Integer Worksheets("Sheet1").Select Range("A1").Select 'For each office listed in Sheet1 copy the orders listed in Sheet2 endRow = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row For iRow = 1 To endRow Worksheets("Sheet1").Select Call copyOrders(Cells(iRow, 1).Value, "Sheet2") Next End Sub Sub copyOrders(office As String, ordersSheet As String) Dim officeSheet Dim ordersRange As Range Static iRow As Integer 'Retain row number where office search ended Dim lastOrdersRow, startRow, endRow As Long Sheets(ordersSheet).Select Range("A1").Select 'Look through the orders sheet and determine the start and end rows for the orders relating to 'the current office. This allows us to copy and paste the block of orders in one operation 'instead of individually. startRow = 0 endRow = 0 iRow = iRow + 1 lastOrdersRow = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row While iRow <= lastOrdersRow + 1 And endRow = 0 If Cells(iRow, 1) = office And startRow = 0 Then startRow = iRow ElseIf Cells(iRow, 1) < office And startRow < 0 Then endRow = iRow - 1 Else iRow = iRow + 1 End If Wend iRow = iRow - 1 'If there are any orders for this office If endRow < 0 Then 'Create a new worksheet if it doesn't exist If worksheetExists(office) Then Set officeSheet = Sheets(office) Else Set officeSheet = Sheets.Add officeSheet.name = office 'Name sheet as the office End If 'Copy the office name and related orders to the office sheet. 'This assumes that the office name is in column A, and the orders are in column B Sheets(ordersSheet).Select Set ordersRange = Range(Cells(startRow, 1), Cells(endRow, 2)) ordersRange.Select Selection.Copy Sheets(office).Select ActiveSheet.Paste Application.CutCopyMode = False End If End Sub Function worksheetExists(WSName As String, Optional WB As Workbook) As Boolean On Error Resume Next worksheetExists = CBool(Len(IIf(WB Is Nothing, ActiveWorkbook, WB).Worksheets(WSName).name)) End Function |
Code is great, except for one thing ...
There is no spaces or empty rows in either sheet 1 or sheet two,
this is just heartbreaking as I really thought I was on the right track. "Ed" wrote in message ... Annette - I'm not an expert on this by any means, but my first thought is that the way your code is getting the last row of the list might be ignoring blanks. In other words, if you have the four cells that would contain the list of offices, but the second one is blank, your code might be stopping at the first one and thinking that is the last row. Try putting MsgBox "My last row is " & endRow right after endRow= etc. and see what it's picking up. If this is the case, you might try making your list of offices a named range, then calling For Each iRow in that range. An If cell is not blank Then do stuff might help, too. 1.5 cents worth. Ed "Annette" wrote in message ... Where would I put that in the code and just to make sure I'm being understood, the code doesn't error out, it just stops running as though it has completed the task. "Don Guillett" wrote in message ... Have a look at onerror then resume next -- Don Guillett SalesAid Software "Annette" wrote in message ... This works great except it will stop if in the list the office is not found. Sheet 1 contains all the offices and sheet2 contains all the information and list of offices and orders (not all offices orders). I need to back a list of the orders to the offices, but this code stops completely if while it runs, a particular office is not found. For example: If this is my list on Sheet 1 Chicago Atlanta Orlando Detroit And sheet 2 has Chicago and Detroit listed, Orlando and Detroit will never get there spreadsheets separated because Atlanta was not in the mix ... I need this code to overlook that missing office and move along! ================ Sub SeparatetoPrepareForEmailing() Dim iRow, endRow As Integer Worksheets("Sheet1").Select Range("A1").Select 'For each office listed in Sheet1 copy the orders listed in Sheet2 endRow = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row For iRow = 1 To endRow Worksheets("Sheet1").Select Call copyOrders(Cells(iRow, 1).Value, "Sheet2") Next End Sub Sub copyOrders(office As String, ordersSheet As String) Dim officeSheet Dim ordersRange As Range Static iRow As Integer 'Retain row number where office search ended Dim lastOrdersRow, startRow, endRow As Long Sheets(ordersSheet).Select Range("A1").Select 'Look through the orders sheet and determine the start and end rows for the orders relating to 'the current office. This allows us to copy and paste the block of orders in one operation 'instead of individually. startRow = 0 endRow = 0 iRow = iRow + 1 lastOrdersRow = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row While iRow <= lastOrdersRow + 1 And endRow = 0 If Cells(iRow, 1) = office And startRow = 0 Then startRow = iRow ElseIf Cells(iRow, 1) < office And startRow < 0 Then endRow = iRow - 1 Else iRow = iRow + 1 End If Wend iRow = iRow - 1 'If there are any orders for this office If endRow < 0 Then 'Create a new worksheet if it doesn't exist If worksheetExists(office) Then Set officeSheet = Sheets(office) Else Set officeSheet = Sheets.Add officeSheet.name = office 'Name sheet as the office End If 'Copy the office name and related orders to the office sheet. 'This assumes that the office name is in column A, and the orders are in column B Sheets(ordersSheet).Select Set ordersRange = Range(Cells(startRow, 1), Cells(endRow, 2)) ordersRange.Select Selection.Copy Sheets(office).Select ActiveSheet.Paste Application.CutCopyMode = False End If End Sub Function worksheetExists(WSName As String, Optional WB As Workbook) As Boolean On Error Resume Next worksheetExists = CBool(Len(IIf(WB Is Nothing, ActiveWorkbook, WB).Worksheets(WSName).name)) End Function |
Code is great, except for one thing ...
Add this line:
startRow = 0 endRow = 0 iRow = iRow + 1 lastOrdersRow = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row If iRow = lastOrdersRow Then iRow = 1 '<==== -- Regards, Tom Ogilvy "Annette" wrote in message ... There is no spaces or empty rows in either sheet 1 or sheet two, this is just heartbreaking as I really thought I was on the right track. "Ed" wrote in message ... Annette - I'm not an expert on this by any means, but my first thought is that the way your code is getting the last row of the list might be ignoring blanks. In other words, if you have the four cells that would contain the list of offices, but the second one is blank, your code might be stopping at the first one and thinking that is the last row. Try putting MsgBox "My last row is " & endRow right after endRow= etc. and see what it's picking up. If this is the case, you might try making your list of offices a named range, then calling For Each iRow in that range. An If cell is not blank Then do stuff might help, too. 1.5 cents worth. Ed "Annette" wrote in message ... Where would I put that in the code and just to make sure I'm being understood, the code doesn't error out, it just stops running as though it has completed the task. "Don Guillett" wrote in message ... Have a look at onerror then resume next -- Don Guillett SalesAid Software "Annette" wrote in message ... This works great except it will stop if in the list the office is not found. Sheet 1 contains all the offices and sheet2 contains all the information and list of offices and orders (not all offices orders). I need to back a list of the orders to the offices, but this code stops completely if while it runs, a particular office is not found. For example: If this is my list on Sheet 1 Chicago Atlanta Orlando Detroit And sheet 2 has Chicago and Detroit listed, Orlando and Detroit will never get there spreadsheets separated because Atlanta was not in the mix ... I need this code to overlook that missing office and move along! ================ Sub SeparatetoPrepareForEmailing() Dim iRow, endRow As Integer Worksheets("Sheet1").Select Range("A1").Select 'For each office listed in Sheet1 copy the orders listed in Sheet2 endRow = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row For iRow = 1 To endRow Worksheets("Sheet1").Select Call copyOrders(Cells(iRow, 1).Value, "Sheet2") Next End Sub Sub copyOrders(office As String, ordersSheet As String) Dim officeSheet Dim ordersRange As Range Static iRow As Integer 'Retain row number where office search ended Dim lastOrdersRow, startRow, endRow As Long Sheets(ordersSheet).Select Range("A1").Select 'Look through the orders sheet and determine the start and end rows for the orders relating to 'the current office. This allows us to copy and paste the block of orders in one operation 'instead of individually. startRow = 0 endRow = 0 iRow = iRow + 1 lastOrdersRow = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row While iRow <= lastOrdersRow + 1 And endRow = 0 If Cells(iRow, 1) = office And startRow = 0 Then startRow = iRow ElseIf Cells(iRow, 1) < office And startRow < 0 Then endRow = iRow - 1 Else iRow = iRow + 1 End If Wend iRow = iRow - 1 'If there are any orders for this office If endRow < 0 Then 'Create a new worksheet if it doesn't exist If worksheetExists(office) Then Set officeSheet = Sheets(office) Else Set officeSheet = Sheets.Add officeSheet.name = office 'Name sheet as the office End If 'Copy the office name and related orders to the office sheet. 'This assumes that the office name is in column A, and the orders are in column B Sheets(ordersSheet).Select Set ordersRange = Range(Cells(startRow, 1), Cells(endRow, 2)) ordersRange.Select Selection.Copy Sheets(office).Select ActiveSheet.Paste Application.CutCopyMode = False End If End Sub Function worksheetExists(WSName As String, Optional WB As Workbook) As Boolean On Error Resume Next worksheetExists = CBool(Len(IIf(WB Is Nothing, ActiveWorkbook, WB).Worksheets(WSName).name)) End Function |
Code is great, except for one thing ...
THAT is iT ... I'm not heart broken anymore ... THANK YOU!
"Tom Ogilvy" wrote in message ... Add this line: startRow = 0 endRow = 0 iRow = iRow + 1 lastOrdersRow = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row If iRow = lastOrdersRow Then iRow = 1 '<==== -- Regards, Tom Ogilvy "Annette" wrote in message ... There is no spaces or empty rows in either sheet 1 or sheet two, this is just heartbreaking as I really thought I was on the right track. "Ed" wrote in message ... Annette - I'm not an expert on this by any means, but my first thought is that the way your code is getting the last row of the list might be ignoring blanks. In other words, if you have the four cells that would contain the list of offices, but the second one is blank, your code might be stopping at the first one and thinking that is the last row. Try putting MsgBox "My last row is " & endRow right after endRow= etc. and see what it's picking up. If this is the case, you might try making your list of offices a named range, then calling For Each iRow in that range. An If cell is not blank Then do stuff might help, too. 1.5 cents worth. Ed "Annette" wrote in message ... Where would I put that in the code and just to make sure I'm being understood, the code doesn't error out, it just stops running as though it has completed the task. "Don Guillett" wrote in message ... Have a look at onerror then resume next -- Don Guillett SalesAid Software "Annette" wrote in message ... This works great except it will stop if in the list the office is not found. Sheet 1 contains all the offices and sheet2 contains all the information and list of offices and orders (not all offices orders). I need to back a list of the orders to the offices, but this code stops completely if while it runs, a particular office is not found. For example: If this is my list on Sheet 1 Chicago Atlanta Orlando Detroit And sheet 2 has Chicago and Detroit listed, Orlando and Detroit will never get there spreadsheets separated because Atlanta was not in the mix ... I need this code to overlook that missing office and move along! ================ Sub SeparatetoPrepareForEmailing() Dim iRow, endRow As Integer Worksheets("Sheet1").Select Range("A1").Select 'For each office listed in Sheet1 copy the orders listed in Sheet2 endRow = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row For iRow = 1 To endRow Worksheets("Sheet1").Select Call copyOrders(Cells(iRow, 1).Value, "Sheet2") Next End Sub Sub copyOrders(office As String, ordersSheet As String) Dim officeSheet Dim ordersRange As Range Static iRow As Integer 'Retain row number where office search ended Dim lastOrdersRow, startRow, endRow As Long Sheets(ordersSheet).Select Range("A1").Select 'Look through the orders sheet and determine the start and end rows for the orders relating to 'the current office. This allows us to copy and paste the block of orders in one operation 'instead of individually. startRow = 0 endRow = 0 iRow = iRow + 1 lastOrdersRow = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row While iRow <= lastOrdersRow + 1 And endRow = 0 If Cells(iRow, 1) = office And startRow = 0 Then startRow = iRow ElseIf Cells(iRow, 1) < office And startRow < 0 Then endRow = iRow - 1 Else iRow = iRow + 1 End If Wend iRow = iRow - 1 'If there are any orders for this office If endRow < 0 Then 'Create a new worksheet if it doesn't exist If worksheetExists(office) Then Set officeSheet = Sheets(office) Else Set officeSheet = Sheets.Add officeSheet.name = office 'Name sheet as the office End If 'Copy the office name and related orders to the office sheet. 'This assumes that the office name is in column A, and the orders are in column B Sheets(ordersSheet).Select Set ordersRange = Range(Cells(startRow, 1), Cells(endRow, 2)) ordersRange.Select Selection.Copy Sheets(office).Select ActiveSheet.Paste Application.CutCopyMode = False End If End Sub Function worksheetExists(WSName As String, Optional WB As Workbook) As Boolean On Error Resume Next worksheetExists = CBool(Len(IIf(WB Is Nothing, ActiveWorkbook, WB).Worksheets(WSName).name)) End Function |
Code is great, except for one thing ...
Did you try the MsgBox? If so, what did you get? Is your code actually
picking up the full range of cells you want to loop through? Just to try something different, if you want to, I usually find the end of a column using LastRow = Range("A65536").End(xlUp).Row (put the correct column after "Range(" ). Also, why do you need to start with selecting Sheet1, and then select it again inside of your loop? If the code hits your first office value and creates the report as required, then all of that is right. The problem should be, then, in your loop through the values. That's why the MsgBox, or stepping through with F8 - you need to know what VBA thinks it's supposed to do. I dove headfirst into the deep end of coding about a year ago, with no prior background in macros. In my experience, the most frustrating and time-consuming portion of writing a useable macro is catching VBA in the act of doing something wrong and making it work right. Don't give up. Some macros have taken me days to debug - but one set of macros by itself saves me about 6 hours every time I use them! Another set has gathered me a few cash awards at work, plus the hero-worship of a few (well, two or less!) coworkers. Keep plugging - the answer *is* there! Ed "Annette" wrote in message ... There is no spaces or empty rows in either sheet 1 or sheet two, this is just heartbreaking as I really thought I was on the right track. "Ed" wrote in message ... Annette - I'm not an expert on this by any means, but my first thought is that the way your code is getting the last row of the list might be ignoring blanks. In other words, if you have the four cells that would contain the list of offices, but the second one is blank, your code might be stopping at the first one and thinking that is the last row. Try putting MsgBox "My last row is " & endRow right after endRow= etc. and see what it's picking up. If this is the case, you might try making your list of offices a named range, then calling For Each iRow in that range. An If cell is not blank Then do stuff might help, too. 1.5 cents worth. Ed "Annette" wrote in message ... Where would I put that in the code and just to make sure I'm being understood, the code doesn't error out, it just stops running as though it has completed the task. "Don Guillett" wrote in message ... Have a look at onerror then resume next -- Don Guillett SalesAid Software "Annette" wrote in message ... This works great except it will stop if in the list the office is not found. Sheet 1 contains all the offices and sheet2 contains all the information and list of offices and orders (not all offices orders). I need to back a list of the orders to the offices, but this code stops completely if while it runs, a particular office is not found. For example: If this is my list on Sheet 1 Chicago Atlanta Orlando Detroit And sheet 2 has Chicago and Detroit listed, Orlando and Detroit will never get there spreadsheets separated because Atlanta was not in the mix ... I need this code to overlook that missing office and move along! ================ Sub SeparatetoPrepareForEmailing() Dim iRow, endRow As Integer Worksheets("Sheet1").Select Range("A1").Select 'For each office listed in Sheet1 copy the orders listed in Sheet2 endRow = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row For iRow = 1 To endRow Worksheets("Sheet1").Select Call copyOrders(Cells(iRow, 1).Value, "Sheet2") Next End Sub Sub copyOrders(office As String, ordersSheet As String) Dim officeSheet Dim ordersRange As Range Static iRow As Integer 'Retain row number where office search ended Dim lastOrdersRow, startRow, endRow As Long Sheets(ordersSheet).Select Range("A1").Select 'Look through the orders sheet and determine the start and end rows for the orders relating to 'the current office. This allows us to copy and paste the block of orders in one operation 'instead of individually. startRow = 0 endRow = 0 iRow = iRow + 1 lastOrdersRow = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row While iRow <= lastOrdersRow + 1 And endRow = 0 If Cells(iRow, 1) = office And startRow = 0 Then startRow = iRow ElseIf Cells(iRow, 1) < office And startRow < 0 Then endRow = iRow - 1 Else iRow = iRow + 1 End If Wend iRow = iRow - 1 'If there are any orders for this office If endRow < 0 Then 'Create a new worksheet if it doesn't exist If worksheetExists(office) Then Set officeSheet = Sheets(office) Else Set officeSheet = Sheets.Add officeSheet.name = office 'Name sheet as the office End If 'Copy the office name and related orders to the office sheet. 'This assumes that the office name is in column A, and the orders are in column B Sheets(ordersSheet).Select Set ordersRange = Range(Cells(startRow, 1), Cells(endRow, 2)) ordersRange.Select Selection.Copy Sheets(office).Select ActiveSheet.Paste Application.CutCopyMode = False End If End Sub Function worksheetExists(WSName As String, Optional WB As Workbook) As Boolean On Error Resume Next worksheetExists = CBool(Len(IIf(WB Is Nothing, ActiveWorkbook, WB).Worksheets(WSName).name)) End Function |
Code is great, except for one thing ...
Dear Annette,
Running the example within Excel I came across the values of iRow. I think that's where this go wrong. Try using within the VBeditor to open the adding controls( I am using a dutch version and am not familiar with the english term) en within the right sub add a checkpoint for each variable. Than you can easily track what is going on in your macro. I will try to get it solved kind regards Ad |
Code is great, except for one thing ...
The problem is the value of iRow within the copyOrders sub. After the first
office is read the value is pushed to a next row and within the sub the value of Cells(iRow,i) becomes blank. "Don Guillett" schreef in bericht ... Have a look at onerror then resume next -- Don Guillett SalesAid Software "Annette" wrote in message ... This works great except it will stop if in the list the office is not found. Sheet 1 contains all the offices and sheet2 contains all the information and list of offices and orders (not all offices orders). I need to email back a list of the orders to the offices, but this code stops completely if while it runs, a particular office is not found. For example: If this is my list on Sheet 1 Chicago Atlanta Orlando Detroit And sheet 2 has Chicago and Detroit listed, Orlando and Detroit will never get there spreadsheets separated because Atlanta was not in the mix ... I need this code to overlook that missing office and move along! ================ Sub SeparatetoPrepareForEmailing() Dim iRow, endRow As Integer Worksheets("Sheet1").Select Range("A1").Select 'For each office listed in Sheet1 copy the orders listed in Sheet2 endRow = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row For iRow = 1 To endRow Worksheets("Sheet1").Select Call copyOrders(Cells(iRow, 1).Value, "Sheet2") Next End Sub Sub copyOrders(office As String, ordersSheet As String) Dim officeSheet Dim ordersRange As Range Static iRow As Integer 'Retain row number where office search ended Dim lastOrdersRow, startRow, endRow As Long Sheets(ordersSheet).Select Range("A1").Select 'Look through the orders sheet and determine the start and end rows for the orders relating to 'the current office. This allows us to copy and paste the block of orders in one operation 'instead of individually. startRow = 0 endRow = 0 iRow = iRow + 1 lastOrdersRow = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row While iRow <= lastOrdersRow + 1 And endRow = 0 If Cells(iRow, 1) = office And startRow = 0 Then startRow = iRow ElseIf Cells(iRow, 1) < office And startRow < 0 Then endRow = iRow - 1 Else iRow = iRow + 1 End If Wend iRow = iRow - 1 'If there are any orders for this office If endRow < 0 Then 'Create a new worksheet if it doesn't exist If worksheetExists(office) Then Set officeSheet = Sheets(office) Else Set officeSheet = Sheets.Add officeSheet.name = office 'Name sheet as the office End If 'Copy the office name and related orders to the office sheet. 'This assumes that the office name is in column A, and the orders are in column B Sheets(ordersSheet).Select Set ordersRange = Range(Cells(startRow, 1), Cells(endRow, 2)) ordersRange.Select Selection.Copy Sheets(office).Select ActiveSheet.Paste Application.CutCopyMode = False End If End Sub Function worksheetExists(WSName As String, Optional WB As Workbook) As Boolean On Error Resume Next worksheetExists = CBool(Len(IIf(WB Is Nothing, ActiveWorkbook, WB).Worksheets(WSName).name)) End Function |
| All times are GMT +1. The time now is 04:55 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com