Find text in worksheet and copy adjacent value to another worksheet

lizzie5 · Feb 14th 2013

Hi, I have been trying to figure this out on my own by looking through the forums but I haven't been able to get my code to work the way I want to. My code below IS working but it is stopping at the first value it finds. I need it to continue searching the worksheet until it finds all matching values. The worksheet will be constantly changing so the code/search needs to be dynamic.

Here is what I'm trying to do:

Search all visible rows in column A on worksheet "Offer Setup Tracker" for text "PROCESSING DATE:"
If it finds "PROCESSING DATE:", copy the adjacent cell value in column B
Paste that copied value in the next available row in column O on worksheet "2013 Totals"

I have attached my file here if it helps. I also put my desired result (a list of dates) in column O on the "2013 Totals" tab.

I have my code in the Workbook_Open slot because I want it to run every time I open the workbook.

Can anyone help? Thanks very much.
forum.ozgrid.com/index.php?attachment/51508/

Code

Dim Cell As Range
    Set Cell = Sheets("Offer Setup Tracker").Range("A:A").SpecialCells(xlCellTypeVisible).Find(What:="PROCESSING DATE:", _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
        
Dim NextRow As Long
    NextRow = Sheets("2013 Totals").Range("O65536").End(xlUp).Row + 1




    If Not Cell Is Nothing Then
        Range(Cell.Offset(0, 1), Cell.Offset(0, 1)).Copy Destination:=Sheets("2013 Totals").Range("O" & NextRow)
    End If

Display More

**pike** · Feb 15th 2013

Re: Find text in worksheet and copy adjacent value to another worksheet

Hello lizzie5
this is for the last row plus one

Code

Destination:=Sheets("2013 Totals").Cells(Rows.Count, "O").End(xlUp).Offset(1, 0)

lizzie5 · Feb 15th 2013

Re: Find text in worksheet and copy adjacent value to another worksheet

Hi, are you saying to replace that code with the last part of mine? So the code would now look like this:

Code

Dim Cell As Range
    Set Cell = Sheets("Offer Setup Tracker").Range("A:A").SpecialCells(xlCellTypeVisible).Find(What:="PROCESSING DATE:", _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
        
Dim NextRow As Long
    NextRow = Sheets("2013 Totals").Range("O65536").End(xlUp).Row + 1




    If Not Cell Is Nothing Then
        Range(Cell.Offset(0, 1), Cell.Offset(0, 1)).Copy Destination:=Sheets("2013 Totals").Cells(Rows.Count, "O").End(xlUp).Offset(1, 0)
        
    End If

Display More

Let me know if I misinterpreted, but if that's what you meant it looks like that's doing the same thing as my original code was. The output on the "2013 Totals" tab is still just showing the first Processing Date found, it's not going through the worksheet and finding all matches.

**pike** · Feb 15th 2013

Re: Find text in worksheet and copy adjacent value to another worksheet

hello,
I will need to see the whole sub
example

Code

Sub ptest()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim FoundOne As Range, LookInR As Range
    Dim fAddress
    Application.ScreenUpdating = False
    Set ws1 = Sheets("Offer Setup Tracker")
    Set ws2 = Sheets("2013 Totals")
   
    Set LookInR = Range(ws1.Range("A1"), ws1.Range("A" & ws1.Rows.Count).End(xlUp))


        With LookInR
            Set FoundOne = .Find(What:="PROCESSING DATE:", LookAt:=xlPart)
            If Not FoundOne Is Nothing Then
                fAddress = FoundOne.Address
                Do
                    FoundOne.Offset(0, 1).Copy Destination:=ws2.Cells(Rows.Count, "O").End(xlUp).Offset(1, 0)
                    Set FoundOne = .FindNext(After:=FoundOne)
                Loop While FoundOne.Address <> fAddress
            End If
        End With
   
    Set ws1 = Nothing
    Set ws2 = Nothing
 
    Set LookInR = Nothing


    Application.ScreenUpdating = True
End Sub

Display More

**pike** · Feb 15th 2013

Re: Find text in worksheet and copy adjacent value to another worksheet

but if can also be done with worksheet functions

lizzie5 · Feb 15th 2013

Re: Find text in worksheet and copy adjacent value to another worksheet

Hi, it looks like the code that you provided in post #4 works great! The only change I made was to add the xlCellTypeVisible to LookInR so it skipped hidden rows in the search. Thank you so much, I really appreciate it!!

**pike** · Feb 15th 2013

Re: Find text in worksheet and copy adjacent value to another worksheet

your welcome thanks for posting
it can be done with out macros
by modifying the array formula

{=IF(ISERROR(INDEX(Sheet1!$A$1:$C$7,SMALL(IF(Sheet1!$B$1:$B$7=$C$1,ROW(Sheet1!$B$1:$B$7)),ROW(1:1)),3)),"",INDEX(Sheet1!$A$1:$C$7,SMALL(IF(Sheet1!$B$1:$B$7=$C$1,ROW(Sheet1!$C$1:$C$7)),ROW(1:1)),3))}

Find text in worksheet and copy adjacent value to another worksheet

Participate now!

Share