Find a Cell on one sheet, write data into another sheet

jnabrown · Feb 26th 2005

I'm new to VBA and I think I'm trying to code a fairly complex algorithm. I just can't figure this out. I want to find a cell on one sheet in my workbook, then when I find the cell, I want to write to a cell in another sheet. After writing to the other sheet, I want to return to the previous sheet and continue the search where I left off. I will then repeat this until I've found all occurences of the Find criteria. I've attached a workbook that has an example of what I'm trying to do. In the test case, search on the "Search Sheet" for the word "Yes". When found, grab the corresponding day and month, then write these values into the table on the "Target Sheet". The hope is that for each value of "Yes" on the "Search Sheet", there will be an entry filled out with a day and month on the "Target Sheet". I've been able to perform the find procedure and write data on the same sheet, but passing back and forth between sheets has not worked.

pradeep_atm · Feb 26th 2005

Re: Find a Cell on one sheet, write data into another sheet

Hi,

Try the following code.

Place the cursor where "yes" is there in your Search sheet and then run this macro. Before running this macro please ensure the following:

Let your Target sheet be Sheet2(if not change the sheet reference). The code start placing the data in Target sheet from Cell A2 on wards, you can change this to your requirements.

[vba]
Sub Cond_Copy()

Application.ScreenUpdating = False
ReturnSheet = ActiveSheet.Name
Set AreaRange = ActiveCell.CurrentRegion
Set MyRange = Intersect(ActiveCell.EntireColumn, AreaRange)

' Define area that matches selected cell value
x = ActiveCell.Value
For Each Cell In MyRange
If Cell.Value = x Then
If i = 0 Then
Set NewRange = Cell.EntireRow
Else
Set NewRange = Union(NewRange, Cell.EntireRow)
End If
i = i + 1
End If
Next
Set NewRange = Intersect(NewRange, AreaRange)

' Copy & Paste
Sheets(2).Select
Cells.ClearContents
Range("A2").Select

NewRange.Copy
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A1").Select

Sheets(ReturnSheet).Select
Application.ScreenUpdating = True

MsgBox ("See Sheet2")
Sheets(2).Select

End Sub
[/vba]

This code I have taken from xl-logic.com. Post back if you have any problems.

HTH.

jnabrown · Feb 26th 2005

Re: Find a Cell on one sheet, write data into another sheet

Thanks alot. This code is definitely going to help me. However, in MyRange, you only selected the first column. How do you select the range to be the entire sheet? Also, you just copied the entire row over when the condition was true. How do you copy a single cell from the row (the day) when the if statement is true?

pradeep_atm · Feb 26th 2005

Re: Find a Cell on one sheet, write data into another sheet

Hi,

[vba]
Set MyRange = Intersect(ActiveCell.EntireColumn, AreaRange)
[/vba]

If you look at the above code, it selects the Intersection of the Activecell.cerrent region(=Area Range) and the current column. That is current data table(unlike UsedRange).

Hence it is taken care in this code.

As far your second question concerned, this code is to place the entire row and not just the cell alone to the next sheet.

HTH.

jnabrown · Feb 26th 2005

Re: Find a Cell on one sheet, write data into another sheet

Again, thank you for the explanation of your code. I understand things much better. But I'm still struggling with one major thing. In your code, you are grabbing the entire rows of data once you get a "Yes". You then join all of the rows together with "Union", and after finding all of the rows, you print them to the next sheet. (I'm still concerned about my second question )

Let me see if I can describe what I'm really looking for here. For the first "Yes", I would want to write "January" and "Monday" to the next sheet, and for the second "Yes", I would want to write "January" and "Wednesday" to the next sheet. Then, I would want to begin searching down the next column "February" for another "Yes". Then "March" and so on, and at each hit, I would want to grab the Month and Day and write them to the next sheet. I've tried taking your code and adding that in, and I just can't seem to get this to work. Thanks again for the help here.

rbrhodes · Feb 26th 2005

Re: Find a Cell on one sheet, write data into another sheet

Hi,
This does what you explained you wanted (wassn't sure about carrying over the formatting/fill). Mess with it and let me know if it needs changing / explaining / etc.

Cheers,

dr

Code

Sub yes()


'Dim variables
Dim y As Long
Dim starta As String
Dim tr As Long, tc As Long
Dim sr As Long, sc As Long
Dim s As Worksheet, t As Worksheet


'Setup
    Application.ScreenUpdating = False
    
    Set t = Sheets("Target Sheet")
    Set s = Sheets("Search sheet")


'Get last used row in Target Sheet
    t.Select
    tr = Range("d65536").End(xlUp).Offset(1, 0).Row
    tc = 4 'target (sheet) column


'Start in search sheet at C4
    s.Select
    Range("c4").Select


'Get 'yes'
    y = Cells.Find(What:="yes", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
     xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
      False).Activate
'Save start address for comparison
    starta = ActiveCell.Address


'Label for goto (pseudo loop)
nextyes:


'Get row/col for copy paste
    sr = ActiveCell.Row
    sc = ActiveCell.Column


'Copy month value to target sheet/cell
    Cells(4, sc).Copy Destination:=t.Cells(tr, tc)
                        
'Copy day value to target sheet/cell
    Cells(sr, 2).Copy Destination:=t.Cells(tr, tc + 1)


'Set destination = plus one row
    tr = tr + 1
'Find next yes (til done)
    y = Cells.FindNext(After:=ActiveCell).Activate
    If ActiveCell.Address = starta Then
        t.Select
        Exit Sub
    End If


'pseudo loop
GoTo nextyes


End Sub

Display More

Cheers,

dr

jnabrown · Feb 27th 2005

Re: Find a Cell on one sheet, write data into another sheet

dr,

You're amazing! The code works exactly the way I wanted it to. I didn't even need the formating, so that was an extra touch. I really appreciate your help here. You have no idea how much you've helped me here. And in so doing, I've learned so much more about how to program in VBA. Thanks alot!!

jnabrown

rbrhodes · Feb 27th 2005

Re: Find a Cell on one sheet, write data into another sheet

Hi

You're welcome! A lot of people (on boards) helped me learn...just passing it on...

dusty

jnabrown · Feb 27th 2005

Re: Find a Cell on one sheet, write data into another sheet

Dusty,

I've got this code working now. If you know off the top of your head, I would appreciate some instruction on how to perform the Copy without the formatting. I just want to copy the values.

Thanks,

Jason

rbrhodes · Feb 27th 2005

Re: Find a Cell on one sheet, write data into another sheet

Jason,

Here's a quick solution. It selects the copied range and kills the fill.

Code

Sub yes()


'Dim variables
Dim y As Long
Dim starta As String
Dim tr As Long, tc As Long
Dim sr As Long, sc As Long
Dim s As Worksheet, t As Worksheet


'Setup
    Application.ScreenUpdating = False
    
    Set t = Sheets("Target Sheet")
    Set s = Sheets("Search sheet")


'Get last used row in Target Sheet
    t.Select
    tr = Range("d65536").End(xlUp).Offset(1, 0).Row
    tc = 4 'target (sheet) column


'Start in search sheet at C4
    s.Select
    Range("c4").Select


'Get 'yes'
    y = Cells.Find(What:="yes", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
     xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
      False).Activate
'Save start address for comparison
    starta = ActiveCell.Address


'Label for goto (pseudo loop)
nextyes:


'Get row/col for copy paste
    sr = ActiveCell.Row
    sc = ActiveCell.Column


'Copy month value to target sheet/cell
    Cells(4, sc).Copy Destination:=t.Cells(tr, tc)
                        
'Copy day value to target sheet/cell
    Cells(sr, 2).Copy Destination:=t.Cells(tr, tc + 1)


'Set destination = plus one row
    tr = tr + 1
'Find next yes (til done)
    y = Cells.FindNext(After:=ActiveCell).Activate
    If ActiveCell.Address = starta Then
        t.Select


'This part
        tr = Range("d65536").End(xlUp).Row
        Range(Cells(5, 4), Cells(tr, 5)).Select
        Selection.Interior.ColorIndex = xlNone
'to here


        Range("d4").Select


        Exit Sub
    End If


'pseudo loop
GoTo nextyes


End Sub

Display More

Cheers,

dusty r

jnabrown · Feb 28th 2005

Re: Find a Cell on one sheet, write data into another sheet

dusty,

Thanks again for the code. Actually, by the time you posted this, I had actually developed a very similar code, thanks to the things that you taught me with the previous code. Again, I appreciate the help that you've given me.

jnabrown

Find a Cell on one sheet, write data into another sheet

Participate now!

Share