vba to run through sorted list and copy rows in each sorted group into a new tab

PatriciaFH · Aug 2, 2019

I’m self taught so the macros I write are quite simple and sometimes long winded. I usually succeed in my endeavours but I’m completely stuck on this one as I don’t know quite how to start.

Sorry if this question has been asked many times before. I’ve looked but can’t find an answer I can apply.

I have a worksheet of data as follows (Sheet name is “DATA”):

Row 1 – Text
Row 2 – Headings (Blue Cells with White Writing) in Columns A to O
The above rows never change

The data below the headings is sorted by Column B which holds the names of different project managers (PMs).

	Col A	Col B	Col C	Cols D-O
Row 1	Text	Text	Text	Text
Row 2	HEADING 1	HEADING 2	HEADING 3	HEADINGS 4-15
Row 3	Data	PM A	Data	Data
Row 4	Data	PM A	Data	Data
Row 6	Data	PM B	Data	Data
Rows 7- ?	Data	PMC	Data	Data

The number of rows for each project manager varies each time the data is entered so the range cannot be defined exactly. The number of project managers (and tabs needed) could be anywhere from 6 to about 20 and the names of the project managers could vary so I can’t define an array of names.

I need a macro that produces a sheet in the workbook for each project manager (by name) and copies the text and headings in Rows 1 & 2 to each sheet. Then runs through the project managers in Column B and copies all the rows of data for each project manager into each relevant tab underneath the pasted headings, ie starting in Row 3 Column A.

I’ve tried several variations on loops and spent hours trawling through forum answers but I can’t get anything to work or that I understand. I’m not sure which action to do in what order. My mind is telling me this should not be too difficult but my brain won't play ball. Any help would be much appreciated.

vcoolio · Aug 2, 2019

Hello Patricia,

Try the following code (untested):-

Code:

Sub CreateNewShtsTransferData()

        Dim sht As Worksheet, ws As Worksheet
        Dim lr As Long, i As Long
        Dim PMID As Object
        Dim key As Variant

        Set sht = Sheets("Data")
        Set PMID = CreateObject("Scripting.Dictionary")
        
Application.ScreenUpdating = False
     
        lr = sht.Range("A" & Rows.Count).End(xlUp).Row

For i = 3 To lr
        If Not PMID.Exists(sht.Range("B" & i).Value) Then
        PMID.Add sht.Range("B" & i).Value, 1
        End If
Next i

For Each key In PMID.keys
        If Not Evaluate("ISREF('" & key & "'!A1)") Then
        Worksheets.Add(After:=Sheets(Sheets.Count)).Name = key
        End If
        
        Set ws = Sheets(key)
        ws.UsedRange.Clear
        sht.Range("B2:B" & lr).AutoFilter 1, key
        sht.[A1].CurrentRegion.Copy ws.[A1]
        ws.Columns.AutoFit
        sht.[B1].AutoFilter
Next key

sht.Select

Application.ScreenUpdating = True

MsgBox "All done!", vbExclamation

End Sub

Test it in a copy of your workbook first.

I hope that this helps.

Cheerio,
vcoolio.

PatriciaFH · Aug 2, 2019

Absolutely wonderful. It works. And so well written that with my limited knowledge, I understand the code and can see how you've built it. Thank you so much, not only for sending this so quickly but for not making it too complicated. I will keep the code in my "how to" book so I can refer to it again.

vcoolio · Aug 2, 2019

Hi Patricia,

You're welcome. I'm glad to have been able to assist. You gave us a very clear description which helps tremendously so thank you for that.

Thanks for the feed-back.

Cheerio,
vcoolio.

vba to run through sorted list and copy rows in each sorted group into a new tab

PatriciaFH

New Member

Excel Facts

vcoolio

Well-known Member

PatriciaFH

New Member

vcoolio

Well-known Member

Similar threads

Forum statistics

Share this page

vba to run through sorted list and copy rows in each sorted group into a new tab

PatriciaFH

New Member

Excel Facts

vcoolio

Well-known Member

PatriciaFH

New Member

vcoolio

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock