More Macro Madness

[Josh in Tampa]

i have an excel worksheet. one of the columns in this
worksheet lists the appropriate state abbreviation for
each record (ie., FL, NY, CA, TX, etc.). i would like to
sort my worksheet by state, and then break my worksheet up
into several different worksheets (if this is even
possible).........so that instead of having one worksheet
with a bunch of different states, i could have as many
worksheets as there are states listed.

i'd like to go from one worksheet with the states i listed
above........to something like:

worksheet 1: all the FL records
worksheet 2: all the NY records
worksheet 3: all the CA records
worksheet 4: all the TX records
and so on and so forth.....

any ideas out there? thanks in advance!

 

[merjet]

Assume the data you want to copy is on Sheet1, columns A-E with
states in C, and row1 is a header and you want a header on the new
sheets. Then the following will do it. Adjust for different assumptions.

Sub Macro1()
Dim iRow1 As Long
Dim iRow2 As Long
Dim strState As String

iRow1 = Sheets("Sheet1").Range("C65536").End(xlUp).Row
Sheets("Sheet1").Range("A1:E" & iRow1).Sort _
Key1:=Range("C2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
iRow1 = 2
Do
If Sheets("Sheet1").Cells(iRow1, 3) <> strState Then
Worksheets.Add after:=Worksheets(Worksheets.Count)
strState = Sheets("Sheet1").Cells(iRow1, 3)
Worksheets(Worksheets.Count).Name = strState
iRow2 = 2
End If
Sheets("Sheet1").Range("A" & iRow1 & ":E" & iRow1).Copy _
Destination:=Worksheets(Worksheets.Count).Range("A" & iRow2 & ":E"
& iRow2)
iRow1 = iRow1 + 1
iRow2 = iRow2 + 1
Loop Until Sheets("Sheet1").Cells(iRow1, 3) = ""
End Sub

HTH,
Merjet

 

[Guest]

thanks, jet.......

this portion of your code turns RED in my VBE:

Sheets("Sheet1").Range("A" & iRow1 & ":E" & iRow1).Copy _
Destination:=Worksheets(Worksheets.Count).Range
("A" & iRow2 & ":E"
& iRow2)

any ideas? thanks.

josh

 

[Josh in Tampa]

jet:

i tried running this macro.....but i got an error stating
that "9 is out of range."

here is the code:

Sub Macro1()
Dim iRow1 As Long
Dim iRow2 As Long
Dim strState As String

iRow1 = Sheets("Sheet1").Range("E65536").End(xlUp).Row
Sheets("Sheet1").Range("A1:H" & iRow1).Sort _
Key1:=Range("E2"), Order1:=xlAscending,
Header:=xlYes, _
OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
iRow1 = 2
Do
If Sheets("Sheet1").Cells(iRow1, 5) <> strState Then
Worksheets.Add after:=Worksheets(Worksheets.Count)
strState = Sheets("Sheet1").Cells(iRow1, 5)
Worksheets(Worksheets.Count).Name = strState
iRow2 = 2
End If
Sheets("Sheet1").Range("A" & iRow1 & ":H" &
iRow1).Copy _
Destination:=Worksheets(Worksheets.Count).Range
("A" & iRow2 & ":H" _
& iRow2)
iRow1 = iRow1 + 1
iRow2 = iRow2 + 1
Loop Until Sheets("Sheet1").Cells(iRow1, 5*) = ""
*********************************************^**error here
End Sub

i marked the spot of the error for you. thanks.


josh

 

[Josh in Tampa]

actually the error was:

Runtime error "9"
subscript out of range.

where am i messing this up?

 

[Tom Ogilvy]

do you really have a 5* in your code?

If so, what is it supposed to mean?

 

[merjet]

this portion of your code turns RED in my VBE:

Sheets("Sheet1").Range("A" & iRow1 & ":E" & iRow1).Copy _
Destination:=Worksheets(Worksheets.Count).Range
("A" & iRow2 & ":E"
& iRow2)

Put the cursor at the end of the 2nd line and use the delete key
until the 2nd-4th lines are on one line (w/o spaces).

HTH,
Merjet

 

[Guest]

no, the * (asterisk) was shown after the number 5 to
designate that as the spot where the error was. i guess
that was kind of confusing. oops.

i just can't figure out how to work this macro so that i
can create multiple worksheets from a single worksheet.
arghhhh.

 

[Mike Tomasura]

this will create the worksheets

Private Sub CommandButton1_Click()

x = 1 ' starting Row
y = 2
Do While Range("A" & x) <> "" ' change "A" to your column where the
states are.

Sheets("Sheet2").Select
Sheets("Sheet1").Copy After:=Sheet1

Sheets("Sheet1 (2)").Select
Sheets("Sheet1 (2)").Name = Sheet1.Cells(x, 1)
x = x + 1: y = y + 1
Loop

End Sub

Then you can just use a loop and an "if" statement to move the records to
the correct worksheet.