Code is great, except for one thing ...

[Annette]

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

 

[Don Guillett]

Have a look at onerror
then resume next

 

[Annette]

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.

 

[Ed]

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]

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.

 

[Tom Ogilvy]

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 '<====

 

[Annette]

THAT is iT ... I'm not heart broken anymore ... THANK YOU!

 

[azis]

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

 

[azis]

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.