Macro for organizing data into worksheets

[robert2290]

Hello,

I am in need of a macro that organizes data into separate worksheets. Basically what I have is thousands of rows of data that are all comprised of both numbers and letters. Every few lines, a value named "Project" will appear. What I want is for each time the word "Project" appears in the 3rd column, the following happen:
-A new sheet is created that is named the last 4 digits of column 4
-All of the rows between "project" and the next time "project" appears to be copied into the new sheet

The Data is organized in the following way:

   1        2        3                                 4
Number	Level	Description	              Name
1	          01	Project	            110002235
2	          01	A	                    110002235
3	          01	1	
4	          01	G	
5	          01	D	
6	          01	I	                    110002235
7	          01	44	
8	          01	WD	
9	          01	Project	            110006933
10	          01	P	                    110006933
11	          02	Docter	
12	          03	D	
13	          03	QE	
14               03	O	
15	          03	QL	
16	          03	P	
17	          03	J	
18	          04	2	
19	          04	6	
20	          04	WWW    	             110006933
21	          04	Project	             110007877
22	          04	l	
23	          04	k	
24	          04	m

(Couldn't get the tag format to look better)
Any help or suggestions would be greatly appreciated.

 

[guerillaunit]

Hope this helps. Feel free to ask any questions

Sub test()
 
Dim upperrange As Long
Dim lowerrange As Long
Dim lastrowofdata As Long
Dim list() As Long
Dim d As Long
 
lowerrange = 2
upperrange = 2
lastrowofdata = ActiveSheet.UsedRange.Rows.Count
 
For Each cell In Range("C2:C" & lastrowofdata)
    If Range("C" & cell.Row).Value = "Project" And cell.Row <> 2 Then
        upperrange = cell.Row
        Rows(lowerrange & ":" & upperrange - 1).Copy
        Sheets.Add.Name = Right(Range("D" & lowerrange).Value, 4)
        Range("a1").PasteSpecial
        Range("a1").Select
        lowerrange = upperrange
        Sheets("sheet1").Activate
    Else
    End If
Next cell
    
For Each cell In Range("C2:c" & lastrowofdata)
    If Range("C" & cell.Row).Value = "Project" Then
        ReDim Preserve list(d)
        list(d) = cell.Row
        d = d + 1
    End If
Next cell
 
max1 = Application.WorksheetFunction.Max(list)
Rows(max1 & ":" & lastrowofdata).Copy
Sheets.Add.Name = Right(Range("D" & max1).Value, 4)
Range("a1").PasteSpecial
Range("a1").Select
Sheets("sheet1").Activate
Application.CutCopyMode = False
    
End Sub

 

[robert2290]

Thank you so much for the code. However, I am getting the following error message:

Run-time error '5':
Invalid procedure call or argument

When I run the debugger, it stops on the "max1 = Application.WorksheetFunction.Max(list)" line

 

[guerillaunit]

Do you have the following references checked in Visual Basic?

-Visual Basic for Applications
-Microsoft Excel 10.0 Object Library
-OLE Automation
-Microsoft Office 10.0 Object Library

 

[robert2290]

Yes. The only difference is that I am using office 14.0

 

[guerillaunit]

I just tried this on Excel 2010 (which uses the 14.0 reference libraries) and was able to run without any problems. Can you take out "max1 = Application.WorksheetFunction.Max(list)" and see if works?

 

[robert2290]

I'm sorry, I do not understand how to remove that line and still make the code run. The subsequent lines are dependent on "max1" and removing it gives you many errors.

I really do appreciate you taking the time to help me with this.

 

[guerillaunit]

Remove

max1 = Application.WorksheetFunction.Max(list)
Rows(max1 & ":" & lastrowofdata).Copy
Sheets.Add.Name = Right(Range("D" & max1).Value, 4)
Range("a1").PasteSpecial

and see if the function runs without any errors

 

[guerillaunit]

Or better yet, upload your workbook onto a file hosting site and post the link

 

[robert2290]

Removing those lines caused the function to run without any errors. Due to company privacy restrictions, I cannot post the workbook (which is why I created the sample set of data).