Automatic alphabetic data extraction macro needed

[TheAssetMgr]

I came across someone in the office today that has been spending huge amounts of time on unnecessary copy/paste/sort gymnastics and it hurt my soul to watch. I know you geniuses can help me/her out so here's what she's doing...

She's working with 3 spreadsheets; I'll call them Initial, Working, and Final.

The Initial file has all the data (and then some) that needs to end up on the Final spreadsheet but the kicker is that the Final spreadsheet has 26 tabs, A-Z and data copied there has to be in a certain tab based on a name. The user is copying 6 columns all at once from Initial to Working, sorting the Patient Name column in Working alphabetically, copying all the As to the Final spreadsheet and then repeating for each letter until there's no more data in Working.

What I'm looking for is a macro that can be executed that will look at Initial, find all the Patient Names beginning with A, copy the required columns of data from Initial to the Final spreadsheet, tab A... and then repeat for Patient Name values beginning with B, and so on.

The Working file the user created was done so the Initial data didn't have to be touched while being worked on. Just a standard CYA working file is all it is. No need to use one in the final solution if it's not necessary.

Any thoughts?

 

[igold]

Can we see some sample data (fictitious is ok) to get an idea of what she is dealing with (especially if the Initial sheet has more data than necessary) and then what part of the initial data has to be moved out to the Alphabetic tabs...

 

[TheAssetMgr]

Sure thing, I'll get that in a couple hours when I'm back in her area.

I forgot to mention that each time she copies the data over to the Final spreadsheet she deletes what's there for the given tab. This is ok because all the existing data, plus the new data, is coming from the Initial spreadsheet.

 

[TheAssetMgr]

I'm realizing that I can't figure out how to paste an image in here. Seems like that should be simple but I'm not able to figure out the

piece of things. Plain text is such a pain to interpret but let me know if you're ok with that. Or, help me out with the image insert process.

 

[Fluff]

You cannot upload files to the site, but there are some add-ins available here that help to include sample data in a post. Add-ins
A few questions
1) Is row 1 a header row, with data starting in A2?
2) Do you need to copy all columns, or only certain ones?
3) Which column has the names?

 

[TheAssetMgr]

Thanks for the quick response. Security is a little cringy about installing plugins on the work machine so I'll try explaining the setup via text.

To your questions, Fluff:

1) Row 1 is a header row, data starts in row 2
2) Only certain columns, C, D, I, R, P, U need to be copied.
3) Column C contains the names. For clarification purposes, they're being alphabetized by first name so the data for "Bob Smith" would end up on the "B" tab in the Final spreadsheet, not the "S" tab.

Column...
C = Patient Name
D = Patient ID #
I = Type of Visit
P = Patient Gender
R = Age in Years
U = Date of birth

Columns A through BT (this is a DB export, hence the number of columns) all present in every Initial spreadsheet but only the above 6 columns are copied over to the Final spreadsheet.

Thanks!

 

[Fluff]

Ok how about

Sub AssetMgr()
    Dim Dic As Object
    Dim Cl As Range
    Dim Ky As Variant
    Dim Wbk As Workbook
    Dim Ws As Worksheet
    
    Set Ws = ActiveSheet
    Set Wbk = Workbooks("[COLOR=#ff0000]Final.xlsx[/COLOR]")
    Set Dic = CreateObject("scripting.dictionary")
    
    Dic.CompareMode = 1
    For Each Cl In Ws.Range("C2", Ws.Range("C" & Rows.Count).End(xlUp))
        Dic.Item(Left(Cl.Value, 1)) = Empty
    Next Cl
    For Each Ky In Dic.Keys
        Ws.Range("A1:U1").AutoFilter 3, Ky & "*"
        Wbk.Sheets(Ky).UsedRange.ClearContents
        Intersect(Ws.AutoFilter.Range, Ws.Range("C:D,I:I,P:P,R:R,U:U")).Copy Wbk.Sheets(Ky).Range("A1")
    Next Ky
    Ws.AutoFilterMode = False
End Sub

The Final workbook needs to be open before running this & change the workbook name in red to suit.
The Sheet with the original data needs to be the activesheet, when the code is run.

 

[TheAssetMgr]

Thanks! I opened the VBA editor and found four modules already in there so I'll obviously need to create this as the 5th, but I'm wondering how to define the keystroke combination to execute it. Right clicking on the module name in the list doesn't appear to give me anything to define what I want to.

It has been quite a while since I've set one of these up so I'm more than rusty.

 

[Fluff]

Are you putting the code in the "Final" workbook?

 

[TheAssetMgr]

Nope, the Initial file. Totally separate workbook.

I ran it manually and receive the following error: Run-time error '9': Subscript out of range

I click Debug and it takes me to this line: Wbk.Sheets(Ky).UsedRange.ClearContents

Thoughts?