Macro - Find text and copy and paste cell below - loop in row

tinylitledragon

New Member
Joined
Nov 5, 2013
Messages
5
hello good people,
please help me. my problem is:

Let´s say sheet - "delivery" - has a row1 that includes all possible delivery days. So A1 is 1.9.2013, B1 is 15.9.2013, C1 is 1.10.2013 and so on.
I want to make a macro, that will gradually go through whole row 3 in sheet "delivery" and look for "A1" date in sheet "Orders". Sheet "orders" have for example in column B the date of delivery, and in column C product of the delivery.
I want the macro to find all deliveries with "A1" date, and paste all products that will be delivered on this day under cell A1 (sheet delivery). then move on to the cell B1 (sheet delivery) - find all orders in sheet orders, that will be delivered on B1 date, and list all products with this delivery date under cell B1 (sheet delivery).

Example:
Sheet order
ABC
Date of deliveryProduct
1.9.2013orange
1.10.2013paper
1.9.2013pencil

<tbody>
</tbody>

Sheet delivery

1.9.201315.9.20131.10.2013
orangepaper
pencil

<tbody>
</tbody>


Can anybody help? Unfortunately simple Pivot table is not able to do this simple list.
Thank you!
 

Some videos you may like

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.

patel45

Well-known Member
Joined
Jul 15, 2012
Messages
1,953
in the first row of Sheet delivery I see 15.9.2013, is not present in Sheet order
 

zhfgtj27

New Member
Joined
Sep 20, 2013
Messages
26
Assuming your date of delivery is in Column A and product in Column B in sheet "orders".

Sub Delivery()
Dim lC As Long, cel As Range, r As Long
lC = ActiveWorkbook.Worksheets("delivery").UsedRange.Columns.Count
For Each cel In ActiveWorkbook.Worksheets("orders").Range("A2:A" & Worksheets("orders").UsedRange.Rows.Count)
For i = 1 To lC
If cel.Value = ActiveWorkbook.Worksheets("delivery").Cells(1, i).Value Then
ActiveWorkbook.Worksheets("delivery").Cells(ActiveWorkbook.Worksheets("delivery").Cells(Rows.Count, i).End(xlUp).Row + 1, i) = _
cel.Offset(0, 1).Value
End If
Next i
Next cel
End Sub
 

tinylitledragon

New Member
Joined
Nov 5, 2013
Messages
5
Hello!
thank you for the macro, I had to adjust it a little bit so it fits to my table (position of the cells), but basically it worked. THANK YOU! Here is the adjusted macro:

Sub delivery()


Dim ws As Worksheet
Dim ws3 As Worksheet


Set ws = Sheets("Order")
Set ws3 = Sheets("Delivery")


Dim lC As Long, cel As Range, r As Long
lC = Sheets("Delivery").UsedRange.Columns.Count
For Each cel In Sheets("Order").Range("M3:M" & Sheets("Order").UsedRange.Rows.Count)
For i = 2 To lC
If cel.Value = Sheets("Delivery").Cells(2, i).Value Then
Sheets("Delivery").Cells(Sheets("Delivery").Cells(Rows.Count, i).End(xlUp).Row + 1, i) = _
cel.Offset(0, -12).Value
End If
Next i
Next cel
End Sub

Anyway, thank you VERY MUCH for your help.
 

Watch MrExcel Video

Forum statistics

Threads
1,122,312
Messages
5,595,427
Members
413,990
Latest member
Kher83

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top