PDA

View Full Version : VBA-Group rows, copy to new worksheet



sbishops
10-28-2008, 10:23 AM
Hello,
I'm trying to find some VBA to do the following steps in excel:
I have a file in excel 2007 with roughly 50K rows of data with 30-40 columns.

I'd like to group by the values found in column A and copy all rows that share column a value to a new worksheet.

pseudo code below:

1. Look down column A for similar values (will be in alpha order).
2. Group rows that have similar values in column A
3. Create new worksheet and name for value in column A and then copy grouped rows into that worksheet.

I see the "copy and paste" method recommended quite often and that's great if you have just a few values, but i have over 370 values with 50,000 plus rows of data and new data comes in every month, so i reallly need some robust VBA to get this done.

Can anyone help me out?

Thanks!
Steph

Adonaioc
10-28-2008, 10:28 AM
Try this for a start if you need more help let me know what you need specificly

sbishops
10-28-2008, 11:10 AM
:yes YOU ARE ABSOLUTELY BRILLIANT!!!! Thank you so much!!!! I think this will work perfectly!!! Thanks again!!!

sbishops
10-28-2008, 11:16 AM
i've looked it over in more detail and am wondering if it's possible to make the worksheet and naming conventions dynamic. the values in column a could change each month and since there's over 370 of these values i would need something dynamic. is that possible?

Adonaioc
10-28-2008, 12:32 PM
Option Explicit
Option Base 1
Sub CopyDatatoNewWorksheets2()
Dim CLL As Range, MasterWS As Worksheet, DestWS As Worksheet
Dim arr(20), i As Long
Dim Rng As Range, LRw As Long
Application.ScreenUpdating = False
Set MasterWS = Sheets("Sheet1")
MasterWS.Rows("1:1").Copy
Application.DisplayAlerts = False
For i = 1 To 20

Worksheets.Add(After:=Worksheets("Sheet1")).Name = "M" & i
MasterWS.Rows("1:1").Copy Range("A1")
arr(i) = "M" & i
Next
Application.DisplayAlerts = True
With MasterWS
LRw = .Cells(Rows.Count, 7).End(xlUp).ROW
Set Rng = .Range("G2:G" & LRw)
For i = 1 To 20
If Application.CountIf(Rng, i) > 0 Then
Rng.AutoFilter Field:=1, Criteria1:=CStr(i)
.Range("A3:K" & LRw).SpecialCells(xlCellTypeVisible).Copy
Sheets("M" & i).Range("A3").PasteSpecial xlAll
End If
Next
Rng.AutoFilter
Sheets(arr).Select
Sheets("M12").Activate
Range("A1").Activate
For i = 1 To 20
Cells(1, i).ColumnWidth = .Cells(1, i).ColumnWidth
Next
.Activate
End With
Application.ScreenUpdating = True
Set CLL = Nothing
Set MasterWS = Nothing
Set DestWS = Nothing
End Sub






You can change the range by changing the values in red, this will initially create the sheets. the second time you run this code you will have to add a
Sheets("M" & i).Delete

After the first

For i = 1 To 20

or it will try and create a new sheet that already exists and it will error out.

This code is pulling from the G column, i pulled it out of one of my sheets, so feel free to tweak it to fit your needs.

sbishops
10-28-2008, 02:54 PM
Wow! you ARE amazing-thanks again! i've been looking for this for a while now and have been trying to do it myself (hard). i can't thank you enuf!