Tricky copy help please

samitnair

Board Regular
Joined
Jul 5, 2010
Messages
155
Hi

I was looking for a Vb which can copy the data from columns according to the serial numbers....
exanple

1. Enter customer name in Sheet 1 B5)
2. Macro Searches the customer name in sheet 2 (B2:B65536)
3. Copy the data of the particular customer mentioned in multiple rows.
4. Paste it in B19 sheet 1
I have attached the pic of sheet 2 for better understanding

2j10gg0.jpg


Now the problem arises while copying....The data or the details like bill no, date and value are entered in 2 or more lines(refer pic) and....i need assistance in copying the data until the macro finds another serial number (1,2,3)...am taking serial number as a Unique value because there are other details mentioned in Column B (Sheet 2) which are not customer name like tds deducted etc....

Please provide me with relevant step.....any suggestion is appreciated.

Thanks in advance
 

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.
What rows would you be copying if ASHISH ENTERPRISES was the customer name? This customer has S.No of 3 but there is another entry in column A in the very next row.
 
Upvote 0
Hi Peter

1. If the customer name is "Ashish Enterprises" the macro must copy E14:G22 (9 rows) from sheet 2 and paste it in B19:D28 Sheet 1 (9 rows)

2. The Alphabet "A" is a error please excuse

Thanks
 
Upvote 0
Test this in a copy of your workbook.

To implement ..

1. Right click the Sheet 1 name tab and choose "View Code".

2. Copy and Paste the code below into the main right hand pane that opens at step 1.

3. Close the Visual Basic window.

4. Enter/Delete customer names in B5.


<font face=Courier New><br><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> Worksheet_Change(<SPAN style="color:#00007F">ByVal</SPAN> Target <SPAN style="color:#00007F">As</SPAN> Range)<br>    <SPAN style="color:#00007F">Dim</SPAN> CustName <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> CustFound <SPAN style="color:#00007F">As</SPAN> Range<br>    <SPAN style="color:#00007F">Dim</SPAN> FirstRow <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, LastRow <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, r <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, rws <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>        <br>    <SPAN style="color:#00007F">Const</SPAN> NameCell <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN> = "B5"<br>    <br>    <SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">Not</SPAN> Intersect(Target, Range(NameCell)) <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN><br>        CustName = Range(NameCell).Value<br>        LastRow = Range("B" & Rows.Count).End(xlUp).Row<br>        <SPAN style="color:#00007F">If</SPAN> LastRow < 19 <SPAN style="color:#00007F">Then</SPAN> LastRow = 19<br>        Application.EnableEvents = <SPAN style="color:#00007F">False</SPAN><br>        Range("B19:D" & LastRow).ClearContents<br>        <SPAN style="color:#00007F">If</SPAN> CustName <> vbNullString <SPAN style="color:#00007F">Then</SPAN><br>            <SPAN style="color:#00007F">With</SPAN> Sheets("Sheet 2")<br>                <SPAN style="color:#00007F">Set</SPAN> CustFound = .Columns("B").Find(What:=CustName, LookIn:=xlValues, _<br>                    LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)<br>                <SPAN style="color:#00007F">If</SPAN> CustFound <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN><br>                    MsgBox CustName & " not found"<br>                <SPAN style="color:#00007F">Else</SPAN><br>                    FirstRow = CustFound.Row<br>                    r = FirstRow<br>                    LastRow = .Range("G" & .Rows.Count).End(xlUp).Row<br>                    <SPAN style="color:#00007F">Do</SPAN><br>                        r = r + 1<br>                    <SPAN style="color:#00007F">Loop</SPAN> <SPAN style="color:#00007F">While</SPAN> .Range("A" & r).Value = "" And r <= LastRow<br>                    rws = r - FirstRow<br>                    Range("B19").Resize(rws, 3).Value = _<br>                        CustFound.Offset(, 3).Resize(rws, 3).Value<br>                <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>        Application.EnableEvents = <SPAN style="color:#00007F">True</SPAN><br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>
 
Upvote 0
Hi Peter

Sorry for the delayed response as i was not keeping well...thanks for the code.The code works as required for copy pasting but i would like to polish it a bit....

for example

1. "ABC enterprises" has 6 entries to be copied and pasted (Works fine)
2. The next customer "DEF Enterprises" has 2 entries.....the code copies and pastes the two entries of "DEF Enterprises" but the four earlier entries of ABC enterprises are not removed...

I would need all previous entries to be deleted as i select a new customer....

If u can help me a bit more then every entry which is copied and pasted from sheet 2 must insert its own rows and paste in them....:confused:

Thanks
 
Upvote 0
I would need all previous entries to be deleted as i select a new customer....
My code does that already for the setup I have. It seems to me that either I have a setup or data different to you or you have modified the code in some way and that has caused the problem.

Here is the part of the code that removes all the previous data from row 19 to the end. I've added some comments to explain the code.


<font face=Courier New><SPAN style="color:#007F00">'Find the last row used in column B on Sheet 1</SPAN><br><SPAN style="color:#007F00">'(which is the sheet containing this code) by starting</SPAN><br><SPAN style="color:#007F00">'at the bottom of col B and going up till data is hit</SPAN><br>LastRow = Range("B" & Rows.Count).End(xlUp).Row<br><br><SPAN style="color:#007F00">'If the last row is < 19 (meaning there was no data)</SPAN><br><SPAN style="color:#007F00">'then make the last row = 19</SPAN><br><SPAN style="color:#00007F">If</SPAN> LastRow < 19 <SPAN style="color:#00007F">Then</SPAN> LastRow = 19<br>Application.EnableEvents = <SPAN style="color:#00007F">False</SPAN><br><br><SPAN style="color:#007F00">'Clear all entries in columns B:D from</SPAN><br><SPAN style="color:#007F00">' row 19 to the last row as calculated above</SPAN><br>Range("B19:D" & LastRow).ClearContents</FONT>


What more can you tell us?
 
Upvote 0
Hi Peter

I am pasting the code in sheet 1 (Destination) and the data to be fetched is pasted in sheet 2...but am not getting any response...or there is no action taken when a customer name is selected in the sheet....

The macros are enabled and am using office 2010...

Thanks
 
Upvote 0
It is possible that your code is not working because 'Events' (eg Worksheet_Change) are disabled. In the VB window, ensure the Immediate Window is visible (View|Immediate Window) and then on a new line in the Immediate Window, type
Application.EnableEvents=True and press Enter
Now go back to your sheet and try changing B5.
 
Upvote 0
I am getting a error in line 9.........
That is not very descriptive.

1. Exactly what is the error message?

2. What is the line of code highlighted when you 'Debug' after the error?

I (and many other users here) choose mostly to not not download files from an unknown source.
 
Upvote 0

Forum statistics

Threads
1,214,833
Messages
6,121,858
Members
449,051
Latest member
excelquestion515

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
Back
Top