Macro to create new worksheets and eliminate rows

Linda Berardo

New Member
Joined
Mar 19, 2009
Messages
16
I have a worksheet that has over 1,500 rows. I need to copy that worksheet and eliminate rows that don't contain certain values. I would paste an example in this post, but I don't know how to do that. I see others but I can't figure it out. When I tried, it didn't work.

I have a header row with descriptions and the one in column a is Unit. So, lets say I have Unit 0807, 0840, 0501, 0502, 0503, 0601, 0683, etc. So, doing this manually I would copy the whole worksheet and then eliminate the all the rows but those with 0807 in the Unit column. I would do the same for 0840 and so on until I created a separate worksheet for each unit.

I would like to create a macro that will allow me to enter a prompt of the unit number and then eliminate all the other rows. Then, I can either save that worksheet as a separate file or create a workbook with 20 worksheets at a time and then save as a separate file.

FYI, there are close to two hundred units. I may run into a worksheet limitation. But I can deal with that by saving the worksheets into separate workbooks. Or, if you have suggestions for that too, I welcome them!

Thanks for any and all input.
 
Last edited:

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
VoG, thank you. I checked it out. Do you know if it will work with Excel 2007? I should have said I was using that version.
 
Upvote 0
I installed Excel Explosion and have the add-in fine but it isn't working right; it's not creating the tabs. Any suggestions? It doesn't give me an error message either.
 
Upvote 0
Sorry, I don't know.

Does this work? - run it with the 'master' sheet selected.

Code:
Sub CodeToSheet()
Dim lastrow As Long, LastCol As Integer, i As Long, iStart As Long, iEnd As Long
Dim ws As Worksheet
Application.ScreenUpdating = False
With ActiveSheet
    lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
    LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
    .Range(.Cells(2, 1), Cells(lastrow, LastCol)).Sort Key1:=Range("A2"), Order1:=xlAscending, _
        Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    iStart = 2
    For i = 2 To lastrow
        If .Range("A" & i).Value <> .Range("A" & i + 1).Value Then
            iEnd = i
            Sheets.Add after:=Sheets(Sheets.Count)
            Set ws = ActiveSheet
            On Error Resume Next
            ws.Name = .Range("A" & iStart).Value
            On Error GoTo 0
            ws.Range(Cells(1, 1), Cells(1, LastCol)).Value = .Range(.Cells(1, 1), .Cells(1, LastCol)).Value
            With ws.Rows(1)
                .HorizontalAlignment = xlCenter
                With .Font
                    .ColorIndex = 5
                    .Bold = True
                End With
            End With
            .Range(.Cells(iStart, 1), .Cells(iEnd, LastCol)).Copy Destination:=ws.Range("A2")
            iStart = iEnd + 1
        End If
    Next i
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
 
Upvote 0
I think I figured it out. I had a couple of blank rows at the top and when I got rid of them, it worked. I also had to get rid of a couple of blank columns because it was dropping off a few columns at the end. Once I did that, it worked like a charm.

Thanks for your quick reply. This is the most awesome site. I'm sharing it with everyone I know.
 
Upvote 0
You are welcome. This has come up a couple of times now that I remember - the data has to start in A1.
 
Upvote 0

Forum statistics

Threads
1,213,551
Messages
6,114,267
Members
448,558
Latest member
aivin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top