extracting specific rows

[wynand]

Looking for help with the following:

Numeric and non numeric data is in A2:F1580, A1:F1 is the header row.
Column C has different names and surnames in one cell, separated by a space.
Some cells have only names, some cells have names, middlenames and surnames
and some have only names and surnames. I would like to extract rows to
another sheet where cells in column C does either have only one name or more
than one name.
Any ideas in terms of a macro or function?

Regards

 

[Joel]

Sub extractsinglenames()

NewRowCount = 2
With ActiveSheet
LastRow = .Range("C" & Rows.Count).End(xlUp).Row
'copy header row
.Row(1).Copy Destination:=Sheets("Sheet2").Rows(1)
For RowCount = 2 To LastRow
If InStr(.Range("C" & RowCount), " ") = 0 Then
.Row(RowCount).Copy _
Destination:=Sheets("Sheet2").Rows(NewRowCount)
NewRowCount = NewRowCount + 1
End If
Next RowCount
End With

End Sub
Sub extractmultinames()

NewRowCount = 2
With ActiveSheet
LastRow = .Range("C" & Rows.Count).End(xlUp).Row
'copy header row
.Row(1).Copy Destination:=Sheets("Sheet2").Rows(1)
For RowCount = 2 To LastRow
If InStr(.Range("C" & RowCount), " ") > 0 Then
.Row(RowCount).Copy _
Destination:=Sheets("Sheet2").Rows(NewRowCount)
NewRowCount = NewRowCount + 1
End If
Next RowCount
End With

 

[wynand]

Joel
i pasted the code into a VB module, press F5 and then get the message:
"run time error "438"
Object does not support this property or method"

 

[Joel]

Sorry, in a couple o spots I typed Row (no s) instead of Rows.

Sub extractsinglenames()

NewRowCount = 2
With ActiveSheet
LastRow = .Range("C" & Rows.Count).End(xlUp).Row
'copy header row
.Rows(1).Copy Destination:=Sheets("Sheet2").Rows(1)
For RowCount = 2 To LastRow
If InStr(.Range("C" & RowCount), " ") = 0 Then
.Rows(RowCount).Copy _
Destination:=Sheets("Sheet2").Rows(NewRowCount)
NewRowCount = NewRowCount + 1
End If
Next RowCount
End With

End Sub
Sub extractmultinames()

NewRowCount = 2
With ActiveSheet
LastRow = .Range("C" & Rows.Count).End(xlUp).Row
'copy header row
.Rows(1).Copy Destination:=Sheets("Sheet2").Rows(1)
For RowCount = 2 To LastRow
If InStr(.Range("C" & RowCount), " ") > 0 Then
.Row(sRowCount).Copy _
Destination:=Sheets("Sheet2").Rows(NewRowCount)
NewRowCount = NewRowCount + 1
End If
Next RowCount
End With

 

[wynand]

Joel
Thank you single names is working excellent.
Multi names shows the following debug error:
.Row(sRowCount).Copy _
Destination:=Sheets("Sheet2").Rows(NewRowCount)'

 

[Joel]

I put the S in the wrong place

from
.Row(sRowCount).Copy _
Destination:=Sheets("Sheet2").Rows(NewRowCount)'
to
.Rows(RowCount).Copy _
Destination:=Sheets("Sheet2").Rows(NewRowCount)'

The two macros are the same except for on e line of code

If InStr(.Range("C" & RowCount), " ") = 0 Then

and

If InStr(.Range("C" & RowCount), " ") > 0 Then

 

[wynand]

thanks works great!!

I put the S in the wrong place

from
.Row(sRowCount).Copy _
Destination:=Sheets("Sheet2").Rows(NewRowCount)'
to
.Rows(RowCount).Copy _
Destination:=Sheets("Sheet2").Rows(NewRowCount)'

The two macros are the same except for on e line of code

If InStr(.Range("C" & RowCount), " ") = 0 Then

and

If InStr(.Range("C" & RowCount), " ") > 0 Then