Stumped on VB Solved/Closed

Question

Hello, 

I am using Excel 2007. In "Sheet1" i am utilizing columns A-O with first rows having headers. In column A,  I have repeating descriptors (7 times each). For example:Each of these descriptors are repeated 7X along with data in rows & up to Column "O".
XXNA
XXNF
XXNP
XXRA
XXRF
XXRP
ZZNA
ZZNF
ZZNP
ZZRA
ZZRF
ZZRP
OOO
TTTE
OOO_X1_ED

I would like to run a macro that groups these descriptors & copy entire rows of data to a new sheet with name of descriptor as the sheet. This will run to the very last row available in Excel 2007, I'm already at 600,000. Example, macro will see:
 "XXN*" & group /copy data in row & up to column "O" in a sheet called "XXN"
"XXR*" & group /copy data in row & up to column "O" in a sheet called "XXR"
"ZZN*" & group /copy data in row & up to column "O" in a sheet called "ZZN"
"ZZR*" & group /copy data in row & up to column "O" in a sheet called "ZZR"
"OOO" & group /copy data in row & up to column "O" in a sheet called "OOO"
"TTTE" & group /copy data in row & up to column "O" in a sheet called "TT"
"OOO_X1_ED" & group /copy data in row & up to column "O" into SAME sheet called "OOO"

Any help would be appreciated. Seems like a mountain and I don't even know where to start.

Thanks,
weenie




Configuration: Windows Vista / Internet Explorer 8.0

TrowaD · Answer

Hi Weenie,

Start by creating sheets with their appropriate names.
Then create headers for each sheet.
If this is the same for all sheets, select all sheets by holding the CTRL button to apply the header to all sheets at once.

Then use the following code structure:
Sub test()
Set MR = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
    For Each cell In MR
    
If (Left(cell.Value, Len("XXN")) = "XXN") Then
    Range(Cells(cell.Row, "A"), Cells(cell.Row, "O")).Copy
    Sheets("XXN").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
        End If
            
If (Left(cell.Value, Len("XXR")) = "XXR") Then
    Range(Cells(cell.Row, "A"), Cells(cell.Row, "O")).Copy
    Sheets("XXR").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
        End If
        
        
            Next
    
    Application.CutCopyMode = False
End Sub
Now copy/paste the part that starts with "If" and ends with "End If".
Then replace XXN or XXR with one of your other search criteria's three times.

Make sure you run the code when sheet1 is activated.

Don't hesitate to ask if something is unclear!

Best regards,
Trowa

weenie · Answer

THANK YOU SO MUCH!!!  

It worked beautiful.  I do have a question.  I am currently at 600,000 rows but when I tested the code I only used 80,000 rows of data (a quickie test of code). It took about ~15-20 mins just to go thru this amount.  So, when I do apply this code to rest of 600,000 rows I imagine it will take a few hours to run this.  Is there a way to make this code sort this faster?  

Thanks,
Weenie

TrowaD · Answer

Sorry Weenie, don't have an answer for that. 

Guess you can split your data into multiple sheets or run the code overnight, since it's probably a one time action.

Best regards,
Trowa

Stumped on VB

3 responses

Similar discussions

Subscribe To Our Newsletter!