Select Case problem

[ambarrovecchio]

Hello all,

I'm trying to get a Select Case macro to work, but I can't quite get it to do what I want. I created a spreadsheet with names of fruit in column A, and I want the macro to copy all of the "Apple" entries into a sheet called "Apple," and the same with "Banana" and "Cherry." However, for all others (Case Else), I want the rows to go into a sheet called "Others."

Instead of splitting the rows up into the different sheets, it dumps all of the data into the "Others" sheet. The code is below. Can someone please help me? I don't understand why it isn't working. Thanks!

Select Case Range("A1:A25").Text 
Case "Apple" 
    Rows.Copy Sheets("Apple").Range("A" & Rows.Count).End(xlUp) 
Case "Banana" 
    Rows.Copy Sheets("Banana").Range("A" & Rows.Count).End(xlUp) 
Case "Cherry" 
    Rows.Copy Sheets("Cherry").Range("A" & Rows.Count).End(xlUp) 
Case Else 
    Rows.Copy Sheets("Others").Range("A" & Rows.Count).End(xlUp) 
End Select

 

[Smitty]

You didn't loop through the range:

<font face=Tahoma><SPAN style="color:#00007F">Sub</SPAN> foo()
    <SPAN style="color:#00007F">Dim</SPAN> c <SPAN style="color:#00007F">As</SPAN> Range
        <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> c <SPAN style="color:#00007F">In</SPAN> Range("A1:A25")
            <SPAN style="color:#00007F">Select</SPAN> <SPAN style="color:#00007F">Case</SPAN> c.Text
                <SPAN style="color:#00007F">Case</SPAN> "Apple"
                    c.EntireRow.Copy Sheets("Apple").Range("A" & Rows.Count).End(xlUp).Offset(1)
                <SPAN style="color:#00007F">Case</SPAN> "Banana"
                    c.EntireRow.Copy Sheets("Banana").Range("A" & Rows.Count).End(xlUp).Offset(1)
                <SPAN style="color:#00007F">Case</SPAN> "Cherry"
                    c.EntireRow.Copy Sheets("Cherry").Range("A" & Rows.Count).End(xlUp).Offset(1)
                <SPAN style="color:#00007F">Case</SPAN> <SPAN style="color:#00007F">Else</SPAN>
                    c.EntireRow.Copy Sheets("Others").Range("A" & Rows.Count).End(xlUp).Offset(1)
            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Select</SPAN>
        <SPAN style="color:#00007F">Next</SPAN> c
End <SPAN style="color:#00007F">Sub</SPAN></FONT>

HTH,

Smitty

 

[ambarrovecchio]

Awesome, that did it. Thanks pennysaver!

 

[Scott Huish]

Your first three Case statements are exactly the same except for the sheet name which is the same as the value in c.Text, you could combine the first three:

Sub foo()
Dim c As Range
For Each c In Range("A1:A25")
    Select Case c.Text
        Case "Apple", "Banana", "Cherry"
            c.EntireRow.Copy Sheets(c.Text).Range("A" & Rows.Count).End(xlUp).Offset(1)
        Case Else
            c.EntireRow.Copy Sheets("Others").Range("A" & Rows.Count).End(xlUp).Offset(1)
    End Select
Next c
End Sub