Automatic alphabetic data extraction macro needed

TheAssetMgr

Board Regular
Joined
Nov 8, 2011
Messages
62
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

Well-known Member
Joined
Jul 8, 2014
Messages
2,447
Office Version
365, 2010
Platform
Windows
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

Board Regular
Joined
Nov 8, 2011
Messages
62
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

Board Regular
Joined
Nov 8, 2011
Messages
62
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
32,440
Office Version
365
Platform
Windows
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

Board Regular
Joined
Nov 8, 2011
Messages
62
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
32,440
Office Version
365
Platform
Windows
Ok how about
Code:
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

Board Regular
Joined
Nov 8, 2011
Messages
62
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
32,440
Office Version
365
Platform
Windows
Are you putting the code in the "Final" workbook?
 

TheAssetMgr

Board Regular
Joined
Nov 8, 2011
Messages
62
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?
 

Forum statistics

Threads
1,082,587
Messages
5,366,486
Members
400,894
Latest member
frog9000

Some videos you may like

This Week's Hot Topics

Top