Sort by Cell Value?

[dan]

Hi, I am using this formula to currently sort a worksheet - If the
value in Column E is Retail, it takes the row and copies it to the
Retail Proj worksheet. It works great, but I want it to go one step
further - If Column E contains the word Retail and Column I contains
anything at all, copy entire row to worksheet Retail Proj. If Column E
contains the word Retail and Column I is empty, copy the entire row to
Retail NoProj.

I guess I'm asking how to add the extra criteria?

Thank you!!!!


Sub Sort()

Dim rCell6 As Range
Dim wsh6 As Worksheet

Set wsh6 = ThisWorkbook.Worksheets.Add(, _
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))

wsh6.Name = "Retail"

For Each rCell6 In
Worksheets("Sheet1").UsedRange.Columns("E").Cells
If rCell6.Value = "Retail" Then
rCell6.EntireRow.Copy Worksheets("Retail
Proj").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End If
Next rCell6

End Sub

 

[Guest]

Sub Sort()

Dim rCell6 As Range
Dim wsh6 As Worksheet

Set wsh6 = ThisWorkbook.Worksheets.Add(, _
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))

wsh6.Name = "Retail"

For Each rCell6 In
Worksheets("Sheet1").UsedRange.Columns("E").Cells
If rCell6.Value = "Retail" Then
if rCell6.offset(0,4).Value = "" then
rCell6.EntireRow.Copy Worksheets( _
"Retail NoProj").Cells(Rows.Count, 1).End( _
xlUp).Offset(1, 0)
else
rCell6.EntireRow.Copy Worksheets( _
"Retail Proj").Cells(Rows.Count, 1).End( _
xlUp).Offset(1, 0)
end if
End If
Next rCell6

End Sub

 

[dan]

Thank you! That worked great! However, when I tried to run it on a
different spreadsheet it didnt work. I got an error saying 'Subscript
Out of Range'.

The only difference is if it says Retail in column H I want it to check
column L to see if something is in it or not. What could the problem
be? I am using the code below.

Thanks!!!!

For Each rCell4 In
Worksheets("Sheet1").UsedRange.Columns("H").Cells
If rCell4.Value = "Retail" Then
If rCell4.Offset(0, 4).Value = "" Then
rCell4.EntireRow.Copy Worksheets( _
"Retail NoProj").Cells(Rows.Count, 1).End( _
xlUp).Offset(1, 0)
Else
rCell4.EntireRow.Copy Worksheets( _
"Retail Proj").Cells(Rows.Count, 1).End( _
xlUp).Offset(1, 0)
End If
End If
Next rCell4

 

[Guest]

Subscript out of range usually means one of the sheet names in your code
doesn't exist.