Hi Mel,

This should do the trick. It will create the new sheet that you want, and
then shift the copied data one column to the right. This means that if you
run the process again then it won't pick up the data in the newly created
sheet.

You can either copy this code into the spreadsheet you are using, or create
an Add-In for it, which would make it available to all new spreadsheets you
receive from your courier. You can run it by pressing ALT + F8 and selecting:

Get_Customers_By_Order

If you use it as an Add-In then this name won't appear, but you can type it
in. If using as an add in then you can create a toolbar button to press to
run the process.

I have run this on a dummy version of your file (invented by me), and it
seems to do what you have asked. If you have any problems running or
implementing this code then let me know and I will try to assist you further,
or if you simply want to know more about how it is working.

I hope this helps.


Public Sub Get_Customers_By_Order()
Dim strOrderID As String
Dim OrderSheet As Worksheet
Dim arrRowArray() As Long
Dim lngFoundRowCount As Long
Dim boolOrderFound As Boolean
Dim strCustomerName As String
Dim NewSheet As Worksheet
Dim lngRowLoopCounter As Long
Dim lngDataRowCounter As Long
strOrderID = InputBox("Please enter order ID", "Order ID")
boolOrderFound = False
For Each OrderSheet In ActiveWorkbook.Worksheets
lngFoundRowCount = Find_Rows(OrderSheet, strOrderID, 2, arrRowArray)
If lngFoundRowCount 0 Then
boolOrderFound = True
strCustomerName = OrderSheet.Cells(arrRowArray(0), 3)
Exit For
End If
Next
If boolOrderFound = False Then
MsgBox ("Order ID not found.")
Else
Set NewSheet =
ActiveWorkbook.Worksheets.Add(after:=ActiveWorkboo k.Worksheets(ActiveWorkbook.Worksheets.Count))
lngDataRowCounter = 2
For Each OrderSheet In ActiveWorkbook.Worksheets
If OrderSheet.Name = NewSheet.Name Then
Exit For
End If
ReDim arrRowArray(0)
lngFoundRowCount = Find_Rows(OrderSheet, strCustomerName, 3,
arrRowArray)
If lngFoundRowCount 0 Then
For lngRowLoopCounter = 0 To lngFoundRowCount - 1
OrderSheet.Activate
OrderSheet.Rows(arrRowArray(lngRowLoopCounter)).Co py
Destination:=NewSheet.Cells(lngDataRowCounter, 1)
lngDataRowCounter = lngDataRowCounter + 1
Next
End If
Next
NewSheet.Activate
With NewSheet
.Columns("A:A").Select
Selection.Insert Shift:=xlToRight
With .Cells(1, 1)
.Value = strCustomerName
.Font.Bold = True
.Select
End With
End With
Set NewSheet = Nothing
End If
End Sub

Private Function Find_Rows(ByVal LocalSheet As Worksheet, ByRef
strLocalSearch As String, _
ByRef intLocalColumn As Integer,
ByRef arrLocalRowArray() As Long) As Long
Dim rngFoundRange As Range
Dim FirstAddress As String
Dim lngOccurrences As Long
With LocalSheet.Columns(intLocalColumn)
Set rngFoundRange = .Find(strLocalSearch, _
after:=Cells(Rows.Count, intLocalColumn), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not rngFoundRange Is Nothing Then
FirstAddress = rngFoundRange.Address
lngOccurrences = 0
Do
ReDim Preserve arrLocalRowArray(lngOccurrences)
arrLocalRowArray(lngOccurrences) = rngFoundRange.Row
lngOccurrences = lngOccurrences + 1
Set rngFoundRange = .FindNext(rngFoundRange)
Loop While Not rngFoundRange Is Nothing And
rngFoundRange.Address < FirstAddress
Find_Rows = lngOccurrences
Else
Find_Rows = 0
End If
End With
End Function

I don't know how the formatting of this code will be when you copy and paste
it, so it might be the case that it required a little editing after you have
pasted into a VBA module.

Sean.


"Meltad" wrote:

Hi,

I've got a monthly workbook showing daily delivery details with each day on
a separate tab, but I need a summary (e.g. the same customer may appear on
more than one tab in the month and I need a summary of all their deliveries).
I tried to create a pivot table with a consolidated data source but this
didn't work so now I'm thinking I may need to write a macro. I can't change
the structure of the spreadsheet as we receive a standard format from the
courier.
Any suggestions how I approach this or whther my requirements below are even
possible!?

Ideally I need to:
- Display an input box for the user to enter an order number (found in
column b of all worksheets).
- Search column b in all worksheets (unique number so will either find 1
value or return a fail).
- Find the corresponding customer name from column c, copy that customer name.
- Add a new worksheet at the end of all other current worksheets and paste
the customer name.
- Search column c in all worksheets and where a match is made copy that
whole row and paste into the new summary worksheet.
- Repeat until all rows on all worksheets for that customer have been found
and entered into the summary tab.

THANK YOU!
Mel :-)