Sorting into multiple sheets

[Seisbye]

I've tried googling this, but i'm only finding issues the wrong way. Maybe i'm google after the wrong thing..

I have each month a set of data, i would like to have sorted/cut n paste to several sheets.

I made a very simple test sheet. for it. in this example you can see what i need to do..

I put in data in data sheet. I then run macro that will sort and move intire lines after there department. always copied after last value. Sorted after dateAttachment 133308
on purpose there are 2 simular lines. while this can be a possebillity.

This example will then create 3 lines in "T 1" and 1 in both "T 2" and "T 3".

Departments and sheets, will increase in time. So a intelligent way to do this instead of hardcoding after each incline in departments is appreciated. I'm think that i can make some kind of look up list of 200 rows. And it will run through and only look for the set range of values. also so this can be used for other purposes.

Hope someone can tell me, what to look for out there, I've tried some kind of a loop with ifs and offset. But that was a terrible setup.. or maybe someone can create this macro in a second.


Also is there som good online tutorials on the setting up applications/loops in vba.. I'm selvtaught from google, and a lot of intrest. And i'm getting better all the time.. I can understand things like

Sub CopyByPage()
Dim rRange As Range, rCell As Range, Helper As Range
Dim wSheet As Worksheet
Dim wsMaster As Worksheet
Dim strText As String

With Application

But only if i get them online. I not good enough to compile theese. and would love to learn.. Because this works better than all the loops I end up making. :-)

In advance Thank you very much..

[Leith Ross]

Hello Seisbye,

The following macro has been added to the attached workbook. There is button on the "Data" sheet to run the macro. I had to rename the sheets "T 1", "T 2", "T 3" to "T1", "T2", "T3". You entered them on the "Data" sheet as "T1", "T2", and "T3".

' Thread:  http://www.excelforum.com/excel-programming/806335-sorting-into-multiple-sheets.html
' Poster:  Seisbye
' Written: December 19, 2011
' Author:  Leith Ross

Sub SortData()

    Dim Cell As Range
    Dim Dict As Object
    Dim DstWks As Worksheet
    Dim Item As Variant
    Dim Key As Variant
    Dim R As Long
    Dim Rng As Range
    Dim RngEnd As Range
    Dim RowData As String
    Dim SrcWks As Worksheet
    
        Set SrcWks = Worksheets("Data")
        Set Rng = SrcWks.Range("A4")
        
            Set RngEnd = SrcWks.Cells(Rows.Count, Rng.Column).End(xlUp)
            If RngEnd.Row < Rng.Row Then Exit Sub Else Set Rng = SrcWks.Range(Rng, RngEnd)
            
            Set Dict = CreateObject("Scripting.Dictionary")
            Dict.CompareMode = vbTextCompare
            
                For Each Cell In Rng
                    Key = Trim(Cell.Offset(0, 2))
                    Item = CStr(Cell.Row)
                        If Key <> "" Then
                           If Not Dict.Exists(Key) Then
                              Dict.Add Key, Item
                           Else
                              Item = Item & "," & Dict(Key)
                              Dict(Key) = Item
                           End If
                        End If
                Next Cell
                
                For Each Key In Dict.Keys
                    Set DstWks = Worksheets(Key)
                    Set RngEnd = DstWks.Cells(Rows.Count, "A").End(xlUp)
                        R = IIf(RngEnd.Row < 4, 4, RngEnd.Row + 1)
                        DataRows = Split(Dict(Key), ",")
                            For Each Item In DataRows
                                SrcWks.Rows(CLng(Item)).EntireRow.Copy DstWks.Rows(R)
                                R = R + 1
                            Next Item
                    R = 0
                Next Key
                
End Sub

[Seisbye]

That just looks PERFECT!! Thank you very much..

I will test it asap.

If i read it correct, then it will look up the name of all the existing sheets correct? So i just add til unlimited?

Also if i'm reading correct, then if the data where to start on row 20. i just correct SrcWks.Range("A4") to "A20" correct? And if the comparrison/department is further away in the coloums i just correct the offset?

Do you have a good link to where i can learn to setup applications like this? I've only learned to do dim x as interger and then setup up objects. But i would love to learn, both all the possibillities. Here you use Variant, long, string etc. And also how to build it up prober.

any good links on this?

[Leith Ross]

Hello Seisbye,

Sorry for the late reply. My computer has been crashing intermittently and I have been attempt to isolate the cause.

Also if i'm reading correct, then if the data where to start on row 20. i just correct SrcWks.Range("A4") to "A20" correct?

If you change the starting row to 20 then you would also need to change another line of code. See below...

  ' This is in the last For ... Next loop

  ' Currently the code is:
    R = IIf(RngEnd.Row < 4, 4, RngEnd.Row + 1)

  ' Code change would be:
    R = IIf(RngEnd.Row < 20, 20, RngEnd.Row + 1)

And if the comparrison/department is further away in the coloums i just correct the offset?

You're correct. The offset in the line below is measured from column "A".

  ' In the First For .. Next loop

  ' This line would need to be adjusted
    Key = Trim(Cell.Offset(0, 2))

[Seisbye]

After some testing i can say it just works PERFECT!! Thank you very much

How do i set thread as solved, when i can't edit my first post?