Report

Copy specific data from Master sheet to multiple sheets.

Ask a question haharrison2 10Posts Friday January 6, 2017Registration date February 7, 2017 Last seen - Last answered on Jan 13, 2017 at 10:00 PM by vcoolio
Master sheet if first tab in workbook containing following:
Case # Case Name Open date Atty Destroy Box #

All rows in numerical order based on Case #. There are 7 attys and I want to copy data from master sheet to tab with attorneys Initials "AAV" on Tab. If data matches criteria based on Atty column and null in columns E and F I want the row copied to that attorneys specific tab.

Please Help, Thank you.
Helpful
+0
plus moins
We can help, but.....

...it is tough to post a turn key solution.

Post some code of where you are stuck, and we can help(emphasize help).
haharrison2 10Posts Friday January 6, 2017Registration date February 7, 2017 Last seen - Jan 7, 2017 at 02:35 PM
Open Explicit

Private Sub Workbook_Open()
Dim i, LastRow

LastRow=Sheets("Master Client Matter List").Range("A" & Rows.Count).end(xlUp).Row
Sheets("AAV').range("A3:F5000").clearContents
for i=3 to LastRow
if sheets("Master Client Matter List").cells(i,"E".value=””and cells(I, “F”.value=””then
sheets(“Master Client Matter List”).cells(I,”E”and “F”) .entirerow.copy Destination=Sheers(“AAV”).Range(“A” & Rows.Count)end(xlUp).Offset(1)
end if
next i
End Sub
Reply
haharrison2- Jan 8, 2017 at 02:09 PM
Help Please. I am really stuck.
Reply
haharrison2- Jan 8, 2017 at 02:15 PM
HELP Hello,

The code listed is the code I am trying to use. I get runtime error "9" Subscript out of range. I don't understand this error. I my code wrong?

Thank you for your time.
haharrison2
Reply
Leave a comment
Helpful
+0
plus moins
Hello Haharrison2,

Looks like ac3mark has gone AWOL!

I can see a number of little issues with your code but to sort this out for you it would be best if you could upload a sample of your work book so that we can try and relate your code to your work book and see where the errors are. You can upload a sample to a free file sharing site such as DropBox, ge.tt or SpeedyShare and then post the link to your file back here. Please de-sensitise your data and put some notes on your Master sheet describing exactly how you want this all to work.

I would also suggest that you not use a Workbook_Open event as you would need to open and close your work book continuously to transfer your data. Assigning the code to a button or creating a Worksheet_Change event would be better options.

In the meantime, please let us know if the following assumptions are correct.

In your Master sheet:-
- There are seven Attorneys each with their own sheet.
- If any row of data has an empty cell in Column E and an empty cell in Column F and the initials of any of the seven Attorneys are placed in Column D then you would like the relevant row of data transferred to the relevant Attorney's sheet (whichever one of the seven).
- Your data starts in row 3 with headings in rows 1 and 2.

Does the data need to be cleared from the Master sheet once transferred to the individual sheets?

Cheerio,
vcoolio.
haharrison2 10Posts Friday January 6, 2017Registration date February 7, 2017 Last seen - Jan 10, 2017 at 04:34 PM
vcoolio,

Not sure you if I attached work correctly yesterday. I had some problems setting it up. Thank you for any and all help. Your assumptions are correct. The only other thing is as the master sheet is updated I need the tabs to update as well.

I do not want the master sheet cleared because everyone will work off the master sheet and attorney tabs will be set to read only. All new data will be input to the master sheet.

Again, Thank you.
https://www.dropbox.com/s/hzm96niti5ypf2a/Master%20Client%20Matter%20List%202.xlsx?dl=0
Reply
Leave a comment
Helpful
+0
plus moins
Hello Haharrison2,

In a standard module, try the following code:-

Sub AllocateAtty()

    Dim lRow As Long
    Dim i As Long
    Dim MySheet As String
lRow = Range("A" & Rows.Count).End(xlUp).Row

Sheet1.Select

On Error Resume Next
For i = 3 To lRow
          MySheet = Cells(i, 4).Value
          If Cells(i, 4) <> "" And Cells(i, 5) = "" And Cells(i, 6) = "" Then
          Range(Cells(i, 1), Cells(i, 6)).Copy Sheets(MySheet).Range("A" & Rows.Count).End(3)(2)
          End If
          Next i

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub


The code will check Column D for a value (<>"") and Columns E and F for blank cells. It will then transfer the relevant rows of data to the relevant individual sheet.

Assign the code to a button. The code will probably take about five seconds to execute as you have a large amount of text in your Master sheet. I have referenced your Master sheet by its sheet code (Sheet1).

I hope that this helps.

Cheerio,
vcoolio.

P.S. : I noticed that some rows have dual Attorney initials. You will need to create new sheets for dual Attorney cases as the code will skip over these.
haharrison2 10Posts Friday January 6, 2017Registration date February 7, 2017 Last seen - Jan 11, 2017 at 02:19 PM
vcoolio,

The code works perfectly. I am jumping with joy. My code was way off the mark. I have not written code since 1998.

I have no words to express how very pleased I am and the fact you took the time to help me. Thank you, Thank you, Thank you.
Reply
Leave a comment
Helpful
+0
plus moins
Hello Haharrison2,

You're welcome. I'm glad that I was able to help.
Good luck with it all.

BTW, it would be a good idea to delete your file from DropBox. That sort of data probably shouldn't remain in cyberspace.

Cheerio,
vcoolio.
haharrison2 10Posts Friday January 6, 2017Registration date February 7, 2017 Last seen - Jan 12, 2017 at 01:06 PM
Thank you, I will.

I found that the sheets will not repopulate unless I delete the data in the atty tabs. New data typed in the master sheet does not automatically populate and will only populate after I delete data in the attorney tabs. Any suggestions would be helpful.

Again thank you for all you help.
Reply
Leave a comment
Helpful
+0
plus moins
Hello Haharrison,

I don't have your workbook to test on as you've done the right thing and deleted it from DropBox but I created a mock-up of your workbook and all works as it should. Each time a button is pressed, any new data is transferred and appended to the bottom of the data already in the individual sheets.

You may have to upload your actual file again temporarily but this time with the code implemented in a module and assigned to a button. We should then be able to sort it out for you.

Cheerio,
vcoolio.
Leave a comment
Helpful
+0
plus moins
Hello again Haharrison,

In the meantime, I thought that perhaps you may be interested in another method. Following is another code that does the same thing but uses auto filter instead. If your data set is to become larger, this method may be quicker for you.

Sub TransferData()

        Dim ar As Variant
        Dim i As Integer
        Dim lr As Long
        t = Timer
        
Application.ScreenUpdating = False

lr = Sheet1.Range("A" & Rows.Count).End(xlUp).Row

Sheet1.Range("G2:G" & lr).Formula = "=IF(AND(D2<>"""",E2="""",F2=""""),D2)"

ar = Array("A", "B", "C", "D")

For i = 0 To UBound(ar)
        'Sheets(ar(i)).UsedRange.ClearContents
            Sheet1.Range("G1", Sheet1.Range("G" & Sheet1.Rows.Count).End(xlUp)).AutoFilter 1, ar(i)
                Sheet1.Range("A1", Sheet1.Range("F" & Sheet1.Rows.Count)).Copy Sheets(ar(i)).Range("A" & Rows.Count).End(3)
Next i
     
Sheet1.[G1].AutoFilter
Sheet1.Range("G2:G" & lr).ClearContents

Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Data transfer completed!", vbExclamation, "Status"
MsgBox (Timer - t)

End Sub


The code actually uses an IF/AND formula to drag the Attorneys' initials over to Column G and then filters on Column G.

Following is the link to my mock-up of your work book. Click on the "RUN" button to see it work.

https://www.dropbox.com/s/m0xdu6tyhi404e2/Filter%2C%20copy%20and%20paste%20on%203%20criteria%20.xlsm?dl=0

I have placed some 10,500 rows in the sample and I've added a timer to the code which will tell you how long the code takes to execute (in your actual work book, I would say that it would take longer to execute due to the amount of text that you have in the work book).

To test that new data is appended to each individual sheet, just delete the data in sheet1 and simply add new data with different lettering (except for Column D as these letters represent your Attorneys and need to remain as is. The sheets are named "A", "B", "C", and "D", representing fictitious Attorneys) then click on "RUN" again.

Please note that, in my sample file, the headings are in row 1 and data starts in row 2, just in case you wish to try this code in your actual work book (remember to test it in a copy of your work book first).

Something else to bear in mind. As you are not clearing data from the Master sheet after it is transferred to each individual sheet, you may well end up with duplicates in the individual sheets. Let us know your thoughts on this.

I hope that I haven't confused you too much!

Cheerio,
vcoolio.
haharrison2 10Posts Friday January 6, 2017Registration date February 7, 2017 Last seen - Jan 13, 2017 at 03:51 PM
vcoolio,

Thank you for the quick response. I have tried the new code and it seems to work. How did you get the run button on your sheet? I am attaching a new link with the entire workbook.

https://www.dropbox.com/s/wfnfun706uk5eig/Master%20Client%20Matter%20List.xlsm?dl=0

Thank you
haharrison2
Reply
haharrison2 10Posts Friday January 6, 2017Registration date February 7, 2017 Last seen - Jan 13, 2017 at 04:28 PM
I attached a link to spreadsheet 2. I get subscript out of range.

I am only a little confused.
Reply
Leave a comment
Helpful
+0
plus moins
Hello Haharrison2,

My security settings won't allow me to download the file. Something to do with its size.

Could you please create a copy of your work book but scale the Master sheet down to about 50 rows of data. Create some of the required criteria additional to that which may already be shown.

Cheerio,
vcoolio.

P.S.: You may be receiving that error message for a couple of reasons:-

1) If you have copied the new code directly to a module, you may have forgotten to change the array (line 15) to your Attorneys' initials.
2) You may not have taken heed of my comment about where the data starts in the sample:-
Please note that, in my sample file, the headings are in row 1 and data starts in row 2, just in case you wish to try this code in your actual work book (remember to test it in a copy of your work book first). 

Hence, in line 13, change G2 to G3. In line 19, change G1 to G2. In line 21, change A1 to A3. In line 25, change G1 to G2. In line 26, change G2 to G3.

In the formula part of line 13, change both D2 to D3, E2 to E3 and F2 to F3.
haharrison2 10Posts Friday January 6, 2017Registration date February 7, 2017 Last seen - Jan 13, 2017 at 06:54 PM
vcoolio,
https://www.dropbox.com/s/ec9khyg8uuanqf0/Master%20Client%20Matter%20List3.xlsm?dl=0

Link to Client List 3. It is a shortened version plus I added a few to the end. I think I changed everything as asked.

Thank you sooo much,
haharrison2
Reply
Leave a comment
Helpful
+0
plus moins
Hello Haharrison2,

Working back late?

I've attached a link to your sample work book with the code implemented and assigned to a button. It all works nicely. Click on the button to see it work.

I'm not sure why you placed the code in each work sheet module as this code is not a Worksheet_Change event. I have removed it from each sheet module. The code is in a standard module, Module 1.

I have gone back to the first code as the second code slows down somewhat while inserting the formula in Column G.

Remember to create a sheet for each Attorney. There is one missing in the sample.

Test the code in a copy of your actual work book.

The link:-

https://www.dropbox.com/s/azgdq6avzzaw91k/Haharrison%20Master%20Client%20Matter%20List3%20%282%29.xlsm?dl=0

Please remember to delete any of your file uploads from DropBox.

I hope that this helps.

Cheerio,
vcoolio.

P.S.: In my first post, I mentioned that a Worksheet_Change event may suit you also so, just in case, here is a Worksheet_Change code that you may prefer over the others:-

Private Sub Worksheet_Change(ByVal Target As Range)

Application.ScreenUpdating = False

If Target.Count > 1 Then Exit Sub
If Target.Value = vbNullString Then Exit Sub
If Intersect(Target, Columns("D:D")) Is Nothing Then Exit Sub

          If Cells(Target.Row, "D") <> "" And Cells(Target.Row, "E") = "" And Cells(Target.Row, "F") = "" Then
          Range(Cells(Target.Row, "A"), Cells(Target.Row, "F")).Copy Sheets(Target.Value).Range("A" & Rows.Count).End(3)(2)
          End If
          
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Done!", vbExclamation

End Sub


To implement this code, right click on the Master sheet tab, select "view code" from the menu that appears and in the big white field that then appears, paste the above code.

For this code to work correctly, you must make any entry in Column D (Attorney initials) your last entry per row. When you click away (or press down arrow or enter), the relevant row of data will be transferred to the relevant individual sheet. As this is a row per row transfer, you shouldn't have any problems with duplicates.

No button is required for this type of code.

Just another option for you.
Leave a comment

Member requests are more likely to be responded to.

Members can monitor the statuses of their requests from their account pages.

A CCM membership gives you access to additional options.

Not a member yet?

Sign up now. It takes less than a minute and is completely free!