Copy row when value NOT found?

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Excel 2003. This one has me stumped. Not sure where to start, since I'm
relying on data being *not* found*

I need to read each row in "Feb_Sheet" looking up the value in column H
(known as PTN) in "Jan_Sheet".

If the PTN is NOT FOUND in Jan_Sheet, then
copy the row from "FebruarySheet" to a just add sheet "Feb_New"
End if

Thanks a ton.
 
Hi,

You didn't tell us where to look for the PTN in the FEB_SHEET so I used
column A. Change to suit

Sub stance()
Dim MyRange As Range
Dim CopyRange As Range
Set sht = Sheets("Feb_Sheet")
Set lookuprange = Sheets("Jan_Sheet").Range("A1:A100") 'Change to suit
lastrow = sht.Cells(Cells.Rows.Count, "H").End(xlUp).Row
Set MyRange = sht.Range("H1:H" & lastrow)
For Each c In MyRange
If WorksheetFunction.CountIf(lookuprange, c.Value) = 0 And c.Value <> ""
Then
If CopyRange Is Nothing Then
Set CopyRange = c.EntireRow
Else
Set CopyRange = Union(CopyRange, c.EntireRow)
End If
End If
Next
If Not CopyRange Is Nothing Then
Worksheets.Add(After:=Worksheets("Feb_Sheet")).Name = "Feb_New"
CopyRange.Copy Sheets("Feb_New").Range("A1")
End If
End Sub
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.
 
OOPS,

wrong way round

You didn't tell us where to look for the PTN in the JAN_SHEET so I used
column A. Change to suit

--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.
 
Mike,
Thanks for the start. Your right about the "PTN". It is in column H for both
sheets.
It seems "CopyRange" is always nothing. One thing I've noticed is that from
month to month, I never how many rows I'll to work with. Here is the code
after I've played with it some:

Sub stance()

Dim MyRange As Range
Dim CopyRange As Range
Dim lookuprange As Range
Dim sht As Worksheet

Set sht = Sheets("Feb_Sheet")
Set lookuprange = Sheets("Jan_Sheet").Range("H1:H10805") 'Change to suit

lastrow = sht.Cells(Cells.Rows.Count, "H").End(xlUp).Row

Set MyRange = sht.Range("H1:H" & lastrow)
For Each c In MyRange
If WorksheetFunction.CountIf(lookuprange, c.Value) = 0 And c.Value < ""
Then
If CopyRange Is Nothing Then
Set CopyRange = c.EntireRow
Else
Set CopyRange = Union(CopyRange, c.EntireRow)
End If
End If
Next

If Not CopyRange Is Nothing Then
Worksheets.Add(After:=Worksheets("Feb_Sheet")).Name = "Feb_New"
CopyRange.Copy Sheets("Feb_New").Range("A1")
End If

End Sub
 
Back
Top