LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,510
Default look in second worksheet if value not found

Hi again,

I confess that the real reason that I did not complete the project for you
was not so much to give you the chance to do it but because I ran out of time.

I have had another look at it and I think that I misinterpreted your use of
blank cell and macro stops. I thought that your macro was unintentionally
aborting on the blank cell but now I think you were using it to determine the
end of the data.

Anyway here is another version which actually finds the end of your data on
each sheet. You will find the method invaluable in the future. I have also
handled looking in sheet 2 if value not found in sheet 1.

With the method used, there is no need for On Error Resume Next for values
not found. In fact, while I admit there are times when the On Error can be a
good tool, I hate using it because one time it did mask an error that needed
to be trapped.

If you have a problem with it then let me know.

Sub PasteValues()

Dim wb1 As Workbook 'Workbook1 - Names to be found
Dim wb2 As Workbook 'Workbook2 - Data to look in
Dim rng1 As Range 'Range of cells to be found Workbook1
Dim rng2 As Range 'Range to look in Workbook2.Sheet1
Dim rng3 As Range 'Range to look in Workbook2.Sheet2
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")

'Name the range of cells to find in wb1.Sht1
'Note:Cells(Rows.count).End(xlUp) is like
'selecting the last cell in column A and
'Pressing Ctrl/Up arrow. It stops on the
'first non empty cell thus identifying it.
wb1.Activate
Worksheets(1).Activate
Set rng1 = wb1.Worksheets(1). _
Range("A1", Cells(Rows.count, 1).End(xlUp))
rng1.Select

'Name the Range of cells in wb2.Sht 1 to look in
wb2.Activate
Worksheets(1).Activate
Set rng2 = wb2.Worksheets(1). _
Range("A1", Cells(Rows.count, 1).End(xlUp))

'Name the Range of cells in wb2.Sht 2 to look in
Worksheets(2).Activate
Set rng3 = wb2.Worksheets(2). _
Range("A1", Cells(Rows.count, 1).End(xlUp))

wb1.Activate
Worksheets(1).Activate
For Each cel_1 In rng1 'Loops through each cell in range

'Next 3 lines skips any blank cells
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)

'If not found in Sheet 1, try sheet 2
If rfoundCell Is Nothing Then
Set rfoundCell = rng3.Find(cel_1.Value, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
End If

'Process if value found in either Sheet 1 or 2
If Not rfoundCell Is Nothing Then

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

'Paste copied cells to right of cell to find wb1
'NOTE: Only need to nominate first cell of range.
wb1.Activate
Worksheets(1).Activate
ActiveSheet.Paste Destination:=Range(cel_1.Address).Offset(0, 1)
Else
End If

endForEach:
Next cel_1

End Sub

" wrote:

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.


 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
when I reopen the excel worksheet I found that the amount changed mary Excel Discussion (Misc queries) 1 September 8th 08 07:04 AM
Return worksheet name containing value found in 3D reference funct PKK Excel Worksheet Functions 8 November 15th 07 04:00 PM
worksheet subroutine causes Compile error: Not found when on User Jim Brownson Excel Programming 3 August 9th 06 07:15 PM
How do I know on which worksheet an item is found? Talar Excel Discussion (Misc queries) 2 June 21st 06 11:56 AM
not found Nathan[_4_] Excel Programming 1 June 25th 04 05:26 AM


All times are GMT +1. The time now is 09:33 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"