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?

 

[Fluff]

In that case check you have a sheet called W, especially check for any leading/trailing spaces on the sheet name.

 

[TheAssetMgr]

Found the problem, and it was my fault for giving you erroneous information. The Final spreadsheet had the last tab labeled "W-Z" and when I broke that out into each letter the code worked great.

I'm going to continue testing to make sure all is well and then I'll try it on the real thing. Thanks so much!

 

[TheAssetMgr]

One more thing... how can I make this a key combo executable macro sort of thing? Just want to keep things simple for the user.

 

[igold]

A little different approach: Same caveats as Fluffs code as far as what needs to be open and what page must be the activesheet.

Sub Alpha()
    
    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim wbF As Workbook: Set wbF = Workbooks("Final.xlsx")
    Dim cols, arr, tL, tB, hdr
    Dim i As Long, ct As Long, nct As Long, rw, a As Long
    Dim nam As String
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    hdr = Array("Patient Name", "Patient ID #", "Type of Visit", "Patient Gender", "Age in Years", "Date of birth")
    tB = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
    cols = Array("3", "4", "9", "16", "19", "21")
    arr = ws.Range("A2:U" & Cells(Rows.Count, 3).End(xlUp).Row)
    ct = 1
    wbF.Activate
    For i = 0 To 25
        Worksheets(tB(i)).Delete
        wbF.Worksheets.Add(after:=Worksheets(wbF.Worksheets.Count)).Name = tB(i)
        For ct = LBound(arr) To UBound(arr)
            If Left(arr(ct, 3), 1) = tB(i) Then
                nct = nct + 1
            End If
        Next
        ReDim tL(1 To nct, 1 To 6)
        nct = 0
        a = 1
        For ct = LBound(arr) To UBound(arr)
            If Left(arr(ct, 3), 1) = tB(i) Then
                nct = nct + 1
                
                For Each rw In cols
                    tL(nct, a) = arr(ct, rw)
                    a = a + 1
                Next
            End If
            a = 1
        Next
        Range("A2").Resize(UBound(tL, 1), UBound(tL, 2)) = tL
        Range("A1").Resize(, UBound(hdr)) = hdr
        tL = Empty
    Next
    Worksheets("A").Select
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
End Sub

 

[igold]

As an aside... Although my code is significantly longer and significantly uglier, on 100K rows of data it runs significantly faster...

 

[TheAssetMgr]

Haha, thanks igold. I wasn't thinking anything bad about your code man, thanks for the alternative input!

 

[igold]

You're welcome. I had been working on it so I thought I would throw it out there. Plus it's always nice to see different ways to do the same thing...

 

[Fluff]

One more thing... how can I make this a key combo executable macro sort of thing? Just want to keep things simple for the user.

To creat a shortcut, in the worksheet use Alt F8 > select the macro from the list > Options > & enter the shortcut you want to use.

 

[TheAssetMgr]

Perfect, thanks very much for the help on this Fluff! You've saved this person about 40 hours a month in ridiculous manual effort - much appreciated!

I appreciate as well your time igold, thanks for the alternative.

 

[Fluff]

Glad we could help & thanks for the feedback