Posts by twvanduzee

I have it working (kinda).

It separates the data the way I want it to (Except breaking down the Community Services sheet).

Here's the code I've come up with -- likely needs some finessing.

Sub transferdata()
Dim dRng As Range 'range for department headings on "Needed Info" sheet
Dim aRng As Range 'range for data on Alldata sheet
Dim dWs As Worksheet 'Needed Info Worksheet
Dim aWs As Worksheet 'AllData Worksheet
Dim aLastrow As Long
'Dim cRow As Double
Dim Number As Long
Dim cLetter As String
Dim vRow As Long

Set aWs = ThisWorkbook.Sheets("Alldata")
Set dWs = ThisWorkbook.Worksheets("Needed Info")
Set dRng = dWs.Range("A1:G1") 'just to give it a value
aLastrow = aWs.Cells(Rows.Count, "A").End(xlUp).Row
Set aRng = aWs.Range("A1:R" & aLastrow)

'Set the range for each column (1 per iteration)
For Each c In dRng
V = c.Value
vRow = 0
    cNumber = c.Column
    cLetter = Split(Cells(1, cNumber).Address, "$")(1)
    vRow = Sheets("Needed Info").Cells(Rows.Count, cLetter).End(xlUp).Row
    Set dRng = Sheets("Needed Info").Range(cLetter & "2:" & cLetter & vRow)
    'MsgBox dRng.Address
        For Each cll In dRng
            aWs.Activate
            With aRng
    'MsgBox aRng.Address
                .AutoFilter 15, cll
                .Offset(1).SpecialCells(12).Copy Sheets(c.Value).Cells(Rows.Count, 1).End(xlUp).Offset(1)
                Worksheets("Alldata").ShowAllData
            End With
        Next cll
    Set dRng = dRng.Offset(0, 1)
'   Stop
Next c
End Sub

I still need to remove the columns, autocolumn width and create workbooks for each of the Manager names (community Services).

But, so far it seems to be going well.

Thank you

Terry

I apologize for any confusion:

On the "Needed Info" sheet:

Community Services, Corporate Services, Executive etc are column headings.

Each value under each column heading matches the values in the O column of the "Alldata" sheet.

I need to find all occurances of each value on "Needed Info" on the "Alldata" sheet and copy the data to the Appropriate sheet.

Each column heading on "Needed Info" matches a sheet name. So ever value under the column heading needs to go to the corresponding sheet.

Ex: sheet "Needed info": Under the column of "Community Services" are several values (Assistant Fire Chief, Bi-law Enforcement, Casual By-law Officer ....etc).

Each of these values exist in the O column. (Title)

Filter the "Alldata" sheet for "Assistant Fire Chief", copy all the results to the "Community Services" sheet. This would be done for all values under all columns of the "Needed Info" sheet.

Ex: sheet "Needed Info". Column "Executive". Look up each value (CAO, Council, Mayor) in the P column of "Alldata". Filter based on the value, Copy to the Executive sheet.

I made the column headings on the "Needed info" sheet the same as the sheet name in an attempt to make it easier to find the sheet to copy to.

I hope this adds a little clarity.

This code is fairly convoluted, But Im trying to figure it out as I go along:

Sub transferdata()
Dim dRng As Range 'range for department headings on "Needed Info" sheet
Dim aRng As Range 'range for data on Alldata sheet
Dim dWs As Worksheet 'Needed Info Worksheet
Dim aWs As Worksheet 'AllData Worksheet
Dim aLastrow As Long
'Dim cRow As Double
Dim Number As Long
Dim cLetter As String
Dim vRow As Long

Set aWs = ThisWorkbook.Sheets("Alldata")
Set dWs = ThisWorkbook.Worksheets("Needed Info")
Set dRng = dWs.Range("A1:G1") 'just to give it a value
aLastrow = aWs.Cells(Rows.Count, "A").End(xlUp).Row
Set aRng = aWs.Range("O1:O" & aLastrow)

'Set the range for each column (1 per iteration)
For Each c In dRng
V = c.Value
vRow = 0
    cNumber = c.Column
    cLetter = Split(Cells(1, cNumber).Address, "$")(1)
    vRow = Cells(Rows.Count, cLetter).End(xlUp).Row
    Set dRng = Range(cLetter & "2:" & cLetter & vRow)  'New dRng
    'MsgBox dRng.Address
        For Each cll In dRng  ' iterate through values in the dRng column
            aWs.Activate
            With aWs.Cells
.AutoFilter 15, cll
.Offset(1).SpecialCells(12).Copy aWs.Cells(Rows.Count, 1).End(xlUp).Offset(1)
End With
        Next cll
    Set dRng = dRng.Offset(0, 1) ' Advance column to the next column
    
Next c
End Sub

Thank You

Terry

Thank You for your reply, I looked at the workbook, and I have included all info that will be needed (even though the Alldata sheet only has 100 or so records, there are actually over 1200 in the spreadsheet. This will end up being a report every week (hense the need to automate).

I will end up removing the B, C, E, G, H, K, L, M, N, Q columns before distributing the data to other sheets.

I have "re-organized" the workbook.

I created a sheet called "Needed Info" that breaks down each department and which "Title" goes on what sheet.

I have created a sheet called "Com Breakdown" that will breakdown "Community Services" into Managers. For the community services sheet. Example-Managers.xlsx

I really appreciate the help with this, Thank you

The v column contains values I typed in, they are sub categories that belong to "Community Services

"sampledata.xlsx

Each sub category of needs to go on it's appropriate sheet.

Col Z contains the a list of unique values for all the Primary divisions.

The xl book only contains a small number of rows in the alldata sheet.

See Attachment

Thank You

Terry

Hello

My last thread worked like a charm. However, it seems management has changed their mind about how they would like to see data.

1. I have data from A to R and approx 1200 rows.

2. I sort by column P in ascending order

3. I created 7 Sheets for the main departments

4. In the P column I have sub categories of all the main departments, which must be copied/pasted to the appropriate sheet..

Sub SeparateSheetData()
Dim rng As Range
Dim rng2 As Range
Dim ws As Worksheet
lastr = ThisWorkbook.Worksheets("Alldata").Cells(Rows.Count, "p").End(xlUp).Row
Set ws = ThisWorkbook.Sheets("Alldata")
Set rng = ws.Range("v2:v11")
Set rng2 = ws.Range("p2:p" & lastr)
Worksheets("Alldata").Range("a1:r" & lastr).Sort key1:=Range("p1"), Order1:=xlAscending, Header:=xlYes
For Each cll In rng.Cells.Value
    For Each c In rng2.Cells.Value
        If c = cll Then
            With Worksheets("Alldata").Range("A2:r" & lastr)
            .AutoFilter Field:=16, Criteria1:=c '& strSearch & "*"
            .Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells.Copy
            Sheets("Community Services").Activate
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            End With
        
        Worksheets("Alldata").Activate
        Worksheets("Alldata").ShowAllData
        Else:
        Exit For
        End If
    Next c
Next cll
End Sub

This works kinda sorta but as you can see, I have to hard code the sheet name.

Also, it iterates through all the values in the sheet for each value in my list.

And of course, the data needs to be appended to the last row on the appropriate sheet.

Any idea how I can make this happen?

Thank You

Terry

Hello

I have a sheet with approximately 1200 rows of data.

Currently, the only way for me to copy rows to different sheets is to select each row (based on specific criteria (column value)).

It all works, but it takes a while to run - because I am iterating through each of the 1200 rows, finding a value from the O column, finding the appropriate sheet to paste it into, and then pasting the entire row of data into the next available row.

So, what Im doing is looking through each cell in the O column, grabbing the value, and comparing it to the sheet names (the sheetnames were created based on the unique values from the O column). When it finds the sheet name with the same value as the cell, it pastes the row into the next available row.

But it does this for 28 different sheets (potentially). so it takes approx 30,000 searches/copies/pastes.

Ex:

the O column contains 50 occurances of "Community Services", 65 occurences of "Corporate Services" etc for 1200 rows of data.

I have sheets by those two names (Community Services and Corporate Services).

Is there a way to have vba scan through all 1200 rows and select/copy all the appropriate rows, then do 1 paste into the appropriate sheet?

Thank You

Terry