A code like the following may do the task for you:-
Sub CopyStuff()
Application.ScreenUpdating = False
With ActiveSheet
.AutoFilterMode = False
With Range("A1", Range("A" & Rows.Count).End(xlUp))
.AutoFilter 1, "C"
On Error Resume Next
.Offset(1).EntireRow.Copy Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1)
End With
.AutoFilterMode = False
End With
Application.ScreenUpdating = True
Sheet2.Select
End Sub
As I don't know what your criteria is, I've just used the letter "C" for now in the code. Change it to suit yourself.
Following is a link to a test work book I did for another Poster some time ago. I believe it is similar to your situation:-
Ahh, so you are trying to copy data from the Master sheet to multiple sheets instead of just one sheet as per your original post.
Then the following code should do the task for you:-
Sub TransferAllData()
Application.ScreenUpdating = False
Dim lRow As Long
Dim MySheet As String
lRow = Range("A" & Rows.Count).End(xlUp).Row
On Error Resume Next
For Each cell In Range("A2:A" & lRow)
MySheet = cell.Value
cell.EntireRow.Copy Sheets(MySheet).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
Sheets(MySheet).Columns.AutoFit
Next cell
Columns(1).SpecialCells(4).EntireRow.Copy Sheets("Unassigned").Range("A" & Rows.Count).End(xlUp).Offset(1)
Sheets("Unassigned").Columns.AutoFit
MsgBox "Data transfer completed!", vbExclamation
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub
Following is a link to my test work book based on the sample work book that you supplied:-
Please note that, as you have a vast amount of text in all columns, the code may take 10 - 15 seconds to run.
By " I would also like the rows that are blank to be moved to the "Unassigned" tab.", I assume that you are referring to those rows that do not have a criteria in Column A.
In your work book, copy all the headings from your Master sheet to all the individual sheets.
To implement the code, in your work book click on the Developer tab. Next, over to the far left, click on Visual Basic. This will open the VB Editor. From the menu bar, select Insert and then Module. Now, in the big white field to the right, paste the above code. To run the code, back on your Master sheet, you can insert a button like I have done in the sample and assign the code to the button. You can also press Alt + F8 which will bring up a little Macro window. Select the macro name (in this case "TransferAllData") in the larger white field then click on Run.
Here is another way which will speed up the process:-
New code:-
Sub FindIDValues()
FindBlanks
Application.ScreenUpdating = False
Dim IDSearch As String
IDSearch = Sheets("Master").Range("B1")
With Sheets("Master")
.AutoFilterMode = False
With Range("A1", Range("A" & Rows.Count).End(xlUp))
.AutoFilter 1, IDSearch
.Offset(1).EntireRow.Copy
Sheets(IDSearch).Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
End With
.AutoFilterMode = False
End With
Sheets(IDSearch).Columns.AutoFit
Application.ScreenUpdating = True
Application.CutCopyMode = False
Sheets("Master").Range("B1") = "Enter Search ID"
Sheets(IDSearch).Select
End Sub
Sub FindBlanks()
Application.ScreenUpdating = False
Sheets("Unassigned").UsedRange.Offset(1).ClearContents
With Sheets("Master")
.AutoFilterMode = False
With Range("A1", Range("A" & Rows.Count).End(xlUp))
.AutoFilter 1, ""
.Offset(1).EntireRow.Copy
Sheets("Unassigned").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
End With
.AutoFilterMode = False
End With
Sheets("Unassigned").Columns.AutoFit
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub
Following is a link to my updated test work book:-
You'll see in the Master sheet that I have added a "Search ID" box in cell B1.
Enter the required ID exactly as per the sheet name (CB, SC, IA) then click on go. As the code executes, it will also take care of the "Unassigned" rows of data.
You can only do it one ID at a time but it is still alot quicker than the other method.
Let me know how it goes.
Just to bore you further, the following code should execute in less than one second:-
Sub FindStuff()
FindStuff2
FindStuff3
FindStuff4
Application.ScreenUpdating = False
Sheets("Unassigned").UsedRange.Offset(1).ClearContents
With Sheets("Master")
.AutoFilterMode = False
With Range("A1", Range("A" & Rows.Count).End(xlUp))
.AutoFilter 1, ""
.Offset(1).EntireRow.Copy
Sheets("Unassigned").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
End With
.AutoFilterMode = False
End With
Sheets("Unassigned").Columns.AutoFit
Application.ScreenUpdating = True
Application.CutCopyMode = False
MsgBox "All done!", vbExclamation
End Sub
Sub FindStuff2()
Application.ScreenUpdating = False
'Sheets("CB").UsedRange.Offset(1).ClearContents
With Sheets("Master")
.AutoFilterMode = False
With Range("A1", Range("A" & Rows.Count).End(xlUp))
.AutoFilter 1, "CB"
.Offset(1).EntireRow.Copy
Sheets("CB").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
End With
.AutoFilterMode = False
End With
Sheets("CB").Columns.AutoFit
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub
Sub FindStuff3()
Application.ScreenUpdating = False
'Sheets("SC").UsedRange.Offset(1).ClearContents
With Sheets("Master")
.AutoFilterMode = False
With Range("A1", Range("A" & Rows.Count).End(xlUp))
.AutoFilter 1, "SC"
.Offset(1).EntireRow.Copy
Sheets("SC").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
End With
.AutoFilterMode = False
End With
Sheets("SC").Columns.AutoFit
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub
Sub FindStuff4()
Application.ScreenUpdating = False
'Sheets("IA").UsedRange.Offset(1).ClearContents
With Sheets("Master")
.AutoFilterMode = False
With Range("A1", Range("A" & Rows.Count).End(xlUp))
.AutoFilter 1, "IA"
.Offset(1).EntireRow.Copy
Sheets("IA").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
End With
.AutoFilterMode = False
End With
Sheets("IA").Columns.AutoFit
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub
It does the whole task quickly with one click of the button. I'm not sure if you wanted the transferred data in each individual sheet cleared before new data is transferred so I have commented out those lines of code in the above macro (the green print). If you need the data cleared, just remove the apostrophe from the begining of each green line of code.
So, every time I click the "transfer data" button, will it add to the existing items or will it rerun itself to update the worksheets?
Every time that you click on the button, each sheet that has data transferred to it will grow ( and grow rather large!). Hence my comment in post #5:-
I'm not sure if you wanted the transferred data in each individual sheet cleared before new data is transferred so I have commented out those lines of code in the above macro (the green print). If you need the data cleared, just remove the apostrophe from the begining of each green line of code.
By clearing the older data from each individual sheet, each individual sheet will be refreshed with any new data which will prevent the sheets from becoming too engorged with data. In the last code I posted above, line 9 does this in the "Unassigned" sheet so you'll notice that the number of rows used in the "Unassigned" sheet remain pretty much static once the code is executed over and over varying only as the number of unassigned rows change in the Master sheet.
But, if you need to keep all data, then your idea of an extra sheet to archive "completed" data would be a good idea. I assume that you would want to enter the word "completed" into Column A of the Master sheet after all the data is transferred so that next time you click on the button, all the older data will be archived in the "Completed" sheet.
But please note that, if you don't clear the older data from each individual sheet, the individual sheets will still grow as new data is added even when the older data from the Master sheet is archived.
Please clarify which way you would like this done and I'll see what I can do for you.
Yes, your first task is to remove the apostrophes.
Next, copy/paste the following code into a second module:-
Sub ArchiveStuff()
Application.ScreenUpdating = False
With Sheets("Master")
.AutoFilterMode = False
On Error Resume Next
With Range("A1", Range("A" & Rows.Count).End(xlUp))
.AutoFilter 1, "Completed"
.Offset(1).EntireRow.Copy
Sheets("Completed").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
.Offset(1).EntireRow.Delete
End With
.AutoFilterMode = False
End With
Sheets("Completed").Columns.AutoFit
Application.ScreenUpdating = True
Application.CutCopyMode = False
Sheets("Completed").Select
End Sub
and assign it to another button (see my updated test work book):-
I've kept the "Archive" code separate to the main code so you can use it randomly, as you wish, to send any rows of data to the "Completed" sheet once "Completed" is placed in Column A of the "Master" sheet and also delete the relevant rows from the "Master" sheet.
Please note:
- "Completed" is case sensitive and
- Ensure the word is placed into the selected cells in Column A before clicking on the "Archive" button.
This should solve the first part of your query. Replacing 4 procedures with one.
Option Explicit
Sub MoveStuff()
Dim ar As Variant, I As Integer
ar = [{"CB","SC","IA","Unassigned";"CB","SC","IA",""}]
Application.ScreenUpdating = False
For I = 1 To UBound(ar, 2)
Sheets(ar(1, i)).UsedRange.Offset(1).ClearContents
With Sheet6 'Shee6 is the Master sheet (sht code name - gold)
.AutoFilterMode = False
With Range("A1", Range("A" & Rows.Count).End(xlUp))
.AutoFilter 1, ar(2, i)
.Offset(1).EntireRow.Copy
Sheets(ar(1, i)).Range("A" & Rows.Count).End(xlUp)(2).PasteSpecial xlPasteValues
ActiveSheet.AutoFilterMode = False
Sheets(ar(1, i)).Columns.AutoFit
End With
End With
Next i
Application.ScreenUpdating = True
Application.CutCopyMode = False
MsgBox "All done!", vbExclamation
End Sub
Hello there. I am so pleased I happened upon this site in my exhausting search for what is described through this thread.
To clarify - Is the above code (written by smallman) intended to replace the code you posted November 7th? I understand the Archive code is separate, but just want to clarify that the above is intended to be a full replace of Find Stuff, Find Stuff 2, Find Stuff 3, and Find Stuff 4 macros.
I know SQL and SAS - but know absolutely nothing about VBA so please forgive my lack of knowledge.
Its a code that I supplied to another Poster about twelve months ago. It actually creates the new sheets and transfers the relevant row of data to each individual sheet. It uses an array for the criteria.
Its a good method if you can't be bothered manually creating your sheets!
I hope that you find the information useful. Good luck!
I was speaking to the Smallman earlier ( he is just amazing with AutoFilter on large data sets and pretty well all things VBA) and he suggested the above trimmed code.
As you can see, it is very slick and a lot less cumbersome and does the same job.
Please raise your glass to the Smallman for his help on this one.
As for writing codes, besides actually going "back to school" and doing a course, you'll find bazillions of tutorials online that will teach you the basics and then build up from there.
Keep an eye on this site as there are many talented Contributors here [I'm still only a junior :-( ] who will help out.
Keep an eye on Smallman's site also (I think its theSmallman.com). He has lots and lots of step by step examples that are well explained.
Hang on to all the codes supplied to you in this thread as they may one day come in handy and you can manipulate them to suit yourself.
Thanks for the info, but I really don't know anything about macros and where I should insert the info. I tried copying off your example and it gave me an error. I'm attaching a sample of my worksheet. I'm trying to copy rows from my "Master" sheet to the corresponding sheets based on criteria in column A. I would also like the rows that are blank to be moved to the "Unassigned" tab. I've learned a lot from these forums but not knowing how to work the codes is a big setback.
This is so awesome!!!! Every worksheet you sent kept getting better and better! So, every time I click the "transfer data" button, will it add to the existing items or will it rerun itself to update the worksheets?
I feel like I'm asking too much already, but let's say that I create a new worksheet "completed", Once I enter that word in column "A", how can I have that line deleted from my master once I transfers the data to the new worksheet?
BTW, THANKS!!!! It's amazing the things that can be done!!
So my goal is to clear and update with any changes made to the Master sheet. So you're correct, I would want to refresh each sheet, otherwise I would duplicate rows of the same information. Based on your original post, I will remove the apostrophe from the green print.
As for the new sheet "completed", you are correct to assume that the word would be entered into column A. I assume once they are archived to the new sheet, I don't run a risk of these rows being duplicated in the completed sheet every time I run a transfer.
End product will have all lines in master eventually in completed sheet and the remaining sheets will be blank as well, at least that's my goal.
You don't know how much help you have been, thanks again!!!
My worksheet is awesome!!! It does everything I wanted it to do and will make my work so much more efficient. I'm so glad I found this site and so glad I found both of you.
Vcoolio, thank you for spending so much time on this, I truly appreciate it.
I followed your instructions to a "T" and I know how to insert and make a macro work. I still don't know how to write codes, but I know where I can get help. I will mimic this code when I'm ready to separate my data by Districts.
6261 users have said thank you to us this month
