View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.misc
OssieMac OssieMac is offline
external usenet poster
 
Posts: 2,510
Default finding and deleting cells from one excel sheet to another

O.K. the try this.

It inserts a column to left of data on both sheets and concatonates all data
in to one column and then looks it up in the second sheet.

Dim rngeSht1 As Range
Dim rngeSht2 As Range
Dim ClientName
Dim Addr1
Dim City
Dim State
Dim c
Dim NameToFind
Dim Y

Sub Delete_Rows()

Sheets("Sheet1").Select

'Insert a column to left of data on sheet 1
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("A1").Select

'Set this to a range as column 1 and to include all rows
Set rngeSht1 = Worksheets("Sheet1").Range("A1", Cells(Rows.Count, 1))

'Concatonate all the values in cells and place in one cell
'Each value trimmed of superflourous leading and trailing spaces
For Each c In rngeSht1
ClientName = Trim(c.Offset(0, 1).Range("A1"))
Addr1 = Trim(c.Offset(0, 2).Range("A1"))
City = Trim(c.Offset(0, 3).Range("A1"))
State = Trim(c.Offset(0, 4).Range("A1"))

c.Value = ClientName & Addr1 & City & State

If c.Value = "" Then
Exit For 'Exit when run out of data
End If
Next c


Sheets("Sheet2").Select

'Insert a column to left of data on sheet 2
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("A1").Select

'Set this to a range as column 1 and to include all rows
Set rngeSht2 = Worksheets("Sheet2").Range("A1", Cells(Rows.Count, 1))

'Concatonate all the values in cells and place in one cell
'Each value trimmed of superflourous leading and trailing spaces
For Each c In rngeSht2
ClientName = Trim(c.Offset(0, 1).Range("A1"))
Addr1 = Trim(c.Offset(0, 2).Range("A1"))
City = Trim(c.Offset(0, 3).Range("A1"))
State = Trim(c.Offset(0, 4).Range("A1"))

c.Value = ClientName & Addr1 & City & State

If c.Value = "" Then
Exit For 'Exit when run out of data
End If
Next c

'For each value in sheet 1, find corresponding value
'in sheet 2 and if found, delete entirerow.
For Each c In rngeSht1
If c.Value = "" Then
Exit For 'Exit when run out of data to find
End If

NameToFind = c.Value
Set Y = rngeSht2.Find(What:=NameToFind, _
LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns _
, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

If Not Y Is Nothing Then 'Y Not Nothing = Found target
Do
Y.EntireRow.Delete
'NOTE: FindNext does not work when a row from the range
'has been deleted. Must repeat full find method
Set Y = rngeSht2.Find(What:=NameToFind, _
LookIn:=xlFormulas, LookAt:=xlWhole,
SearchOrder:=xlByColumns _
, SearchDirection:=xlNext, MatchCase:=False,
SearchFormat:=False)
Loop While Not Y Is Nothing
End If

Next c
Sheets("Sheet1").Select
Columns("A:A").Delete
Range("A1").Select
Sheets("Sheet2").Select
Columns("A:A").Delete
Range("A1").Select

Regards,

OssieMac