Home |
Search |
Today's Posts |
#3
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
when I reopen the excel worksheet I found that the amount changed | Excel Discussion (Misc queries) | |||
Return worksheet name containing value found in 3D reference funct | Excel Worksheet Functions | |||
worksheet subroutine causes Compile error: Not found when on User | Excel Programming | |||
How do I know on which worksheet an item is found? | Excel Discussion (Misc queries) | |||
not found | Excel Programming |