look in second worksheet if value not found

[boegerscience]

Hi everyone,
Using email addresses in Workbook1, I need to find those email
addresses in Workbook2, then copy/paste, the 8 cells next to the found
cells back to Workbook1. The macro goes down each cell until it hits
a blank one a stops. It's my first macro ever so pardon if it's
ugly. If you see something where you go, "WTF was he doing?" let me
know what a better way is. I appreciate the feedback.

My macro uses the FIND method and I want it to look at worksheet 2 if
it doesn't find it. Something like

If foundcell is nothing then
(look in worksheet two instead)
else
(do the normal stuff)

I tried creating a second range similar to oRng except with
Worksheets(2) and using that in the "If" statement but it didn't
work. Also, I'll need some sort of On Error Resume Next if the value
isn't found in either worksheets.

Here's my current code:

Option Explicit
Option Compare Text
Sub PasteValues()
Dim aRng as Range
Dim oRng as Range
Dim rfoundCell as Range
Dim count as Byte
Const CELLNUM as Byte = 8 'the number of cells to copy, I want
this flexible
set oRng = Workbooks("sourcesheet.xls").Worksheets(1).Range("A:H")
set aRng = ActiveCell

Do While aRng.Value <> ""
On Error Resume Next
Set rFoundCell = oRng.Find(aRng.Value, LookIn:=xlValues)
count = 1
Do Until count = CELLNUM
aRng.Offset(0, count).Value = rfoundCell.Offset(0,
count).Value
count = count + 1
Loop
Set aRng = aRng.Offset(1,0)
Loop
set aRng = Nothing
set rfoundCell = Nothing
set oRng = Nothing

End Sub

Thanks a bunch. As an aside, if anyone has a really good book
suggestion, I'm a taker. I read online help and most of Excel 2003
programming Inside and Out and I guess this is as far as it got me.

 

[OssieMac]

Hi ?????,

I have had a look at your request. The following code should achieve the
first part of your requirements but I have not done anything with the 'Not
Found'.

Since you seem eager to learn you might like to try it yourself. Just set up
a find, copy, paste in the Else part of the If, Then, Else test for the find
using the same value to find.

If you post a reply to this and let me know how you go then I am happy to
help further if you need it.

I have left a msgbox in the For Each Loop. It helps with testing. Simply
place a single quote at the beginning of it to comment it out when you no
longer need it.

If you want to stop the program at any time during the loop, including when
the msgbox is displayed then Ctrl/Break will stop it.

In Find you should always use all the Arguments (parameters) because xl
remembers them from the last use even if it was in the interactive mode.
Things like After Activecell have to come out but most of the others remain.
If unsure, record a macro to see which ones it uses. The .Activate at the end
also comes off. See this in help and click on show all and read about it in
Remarks.

Sub PasteValues()

Dim wb1 As Workbook 'Workbook1
Dim wb2 As Workbook 'Workbook2
Dim rng1 As Range 'Range of cells to be found Workbook1
Dim rng2 As Range 'Range to look in Workbook2
Dim cel_1 As Range 'Each cell in rng1
Dim rfoundCell As Range 'Range of found cell
Dim cellNum As Single 'The number of cells to copy

cellNum = 8 'Set this to any number you like

'Replace workbook names in the following 2 lines
'with your workbook names
Set wb1 = Windows.Application.Workbooks("Workbook1.xls")
Set wb2 = Windows.Application.Workbooks("Workbook2.xls")

Set rng1 = wb1.Worksheets(1).Range("A1:A100") 'Cells to find
Set rng2 = wb2.Worksheets(1).Range("A1:A1000") 'Range to look in

For Each cel_1 In rng1 'Loops through each cell in range

'Next 3 lines skips blank cell
If Len(Trim(cel_1.Value)) = 0 Then
GoTo endForEach
End If

Set rfoundCell = rng2.Find(cel_1.Value, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

'Next line will allow processing if value is found
If Not rfoundCell Is Nothing Then

'Delete the next line after testing
MsgBox "found " & rfoundCell.Value

'Copy 8 cells to right of found cell in workbook2
wb2.Worksheets(1).Range(rfoundCell.Offset(0, 1), _
rfoundCell.Offset(0, cellNum)).Copy

'Paste copied cells to right of cell to find wb1
wb1.Worksheets(1).Paste Destination:= _
Worksheets(1).Range(cel_1.Offset(0, 1), _
cel_1.Offset(0, cellNum))

Else
'Insert your code here to handle values not found
MsgBox "Did not find " & cel_1.Value & " Address " & cel_1.Address
End If

endForEach:
Next cel_1

End Sub

Regards and best of luck with it,

OssieMac