Hi
I have several rows of information in a worksheet I need a macro or code to
select only the rows that do not have the word "keep" anywhere in them, copy
those rows and open a new workbook and paste them into the worksheet then
save the worksheet in my documents with month as the filename.
I manage to do this with a macro selecting specific rows by drag and select
but the layout changes so this no good.
Help appreciated
Thanks

Hi Kim,

'-------------------
I have several rows of information in a worksheet I need a macro or code to
select only the rows that do not have the word "keep" anywhere in them,
copy
those rows and open a new workbook and paste them into the worksheet then
save the worksheet in my documents with month as the filename.
I manage to do this with a macro selecting specific rows by drag and select
but the layout changes so this no good.
'-------------------

Try something like;

'================
Public Sub Tester()
Dim WB As Workbook
Dim SH As Worksheet
Dim destSH As Worksheet
Dim rng As Range
Dim rCell As Range
Dim Rng2 As Range
Dim iRow As Long
Dim CalcMode As Long
Const sStr As String = "keep" '<<===== CHANGE

Set WB = Workbooks("MyBook.xls") '<<===== CHANGE
Set SH = WB.Sheets("Sheet1") '<<===== CHANGE

With SH
iRow = .Cells(Rows.Count, "A").End(xlUp).Row
Set rng = SH.Range("A1:A" & iRow)
End With

On Error GoTo XIT
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With


For Each rCell In rng.Cells
If Application.CountIf( _
rCell.EntireRow, "*" & sStr & "*") Then
If Rng2 Is Nothing Then
Set Rng2 = rCell
Else
Set Rng2 = Union(rCell, Rng2)
End If
End If
Next rCell

If Not Rng2 Is Nothing Then
With WB
Set destSH = .Worksheets.Add( _
After:=.Sheets(.Sheets.Count))
End With

With destSH
Rng2.Copy Destination:=destSH.Range("A1")
.Name = Format(Date, "mmmm")
.Copy
End With

With ActiveWorkbook
.SaveAs Filename:=destSH.Name & ".xls"
.Close SaveChanges:=False
End With
End If

XIT:
With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With
End Sub
'<<================


---
Regards,
Norman

Hi Kim,


Re-reading your post, replace:

If Application.CountIf( _
rCell.EntireRow, "*" & sStr & "*") Then


with

If Application.CountIf( _
rCell.EntireRow, "*" & sStr & "*") = 0 Then


---
Regards,
Norman

Thanks Norman it produced the workbook but no data pasted. I moved my data to
cell A1 tried again . It did paste only the rows but only the data in column
A how can get to paste data from the other columns?
I tried to figure this out by looking a t the code but can't get there!
Thanks

"Norman Jones" wrote:

Hi Kim,


Re-reading your post, replace:

If Application.CountIf( _
rCell.EntireRow, "*" & sStr & "*") Then


with

If Application.CountIf( _
rCell.EntireRow, "*" & sStr & "*") = 0 Then


---
Regards,
Norman

Hi Norman
I chaged the range in the code from A1:A to A1:Z400
This caught the data was this the correct approach?
Thanks

"kim" wrote:

Thanks Norman it produced the workbook but no data pasted. I moved my data to
cell A1 tried again . It did paste only the rows but only the data in column
A how can get to paste data from the other columns?
I tried to figure this out by looking a t the code but can't get there!
Thanks

"Norman Jones" wrote:

Hi Kim,


Re-reading your post, replace:

If Application.CountIf( _
rCell.EntireRow, "*" & sStr & "*") Then


with

If Application.CountIf( _
rCell.EntireRow, "*" & sStr & "*") = 0 Then


---
Regards,
Norman

Hi Kim,

'----------------
I chaged the range in the code from A1:A to A1:Z400
This caught the data was this the correct approach?
'----------------

See my response to your previous post..

However, it should be necessary only to replace 'A'
with a column that defines the last data row.

To copy the entire data rows, adopt also my second
suggestion.


---
Regards,
Norman

Hi Kim,

'------------------
Thanks Norman it produced the workbook but no data pasted. I moved my data
to
cell A1 tried again . It did paste only the rows but only the data in column
A how can get to paste data from the other columns?
I tried to figure this out by looking a t the code but can't get there!
'------------------

(1) Change:

Set rng = SH.Range("A1:A" & iRow)

to reflect a column which encompasses all of your data.


(2) Change

Rng2.Copy Destination:=destSH.Range("A1")

to:

Rng2EntireRow.Copy Destination:=destSH.Range("A1")


---
Regards,
Norman

Hi Norman
Looking at this, away from the code ,for what I need to record it makes more
sense to have the code copy the rows where the word "Keep" does not appear is
it possible to change the code to do this?
Thanks for your help

"Norman Jones" wrote:

Hi Kim,

'------------------
Thanks Norman it produced the workbook but no data pasted. I moved my data
to
cell A1 tried again . It did paste only the rows but only the data in column
A how can get to paste data from the other columns?
I tried to figure this out by looking a t the code but can't get there!
'------------------

(1) Change:

Set rng = SH.Range("A1:A" & iRow)

to reflect a column which encompasses all of your data.


(2) Change

Rng2.Copy Destination:=destSH.Range("A1")

to:

Rng2EntireRow.Copy Destination:=destSH.Range("A1")


---
Regards,
Norman

Thanks Norman that last code seems to have worked and done the job. One more
thing it puts the copied information in a new workbook is it possible to put
some code in there t0 save the workbook in my documents?
Thanks

"Norman Jones" wrote:

Hi Kim,

'------------------
Thanks Norman it produced the workbook but no data pasted. I moved my data
to
cell A1 tried again . It did paste only the rows but only the data in column
A how can get to paste data from the other columns?
I tried to figure this out by looking a t the code but can't get there!
'------------------

(1) Change:

Set rng = SH.Range("A1:A" & iRow)

to reflect a column which encompasses all of your data.


(2) Change

Rng2.Copy Destination:=destSH.Range("A1")

to:

Rng2EntireRow.Copy Destination:=destSH.Range("A1")


---
Regards,
Norman