0

Pulling my hair finding code that can help me, hate not providing anything but if anyone can help what I'm after should be pretty simple.

I want a code to find certain text in Column E in Sheet 1(example "San Fransico") and paste 50 cells below that into Sheet 2 range D4. I can then adjust the code to search based on cell value and change event when that cell changes the macro runs. I just need a push start as I'm not getting anywhere with the above. Any help is hugely appreciated and apologies again for not having an example, nothing i tried came close.

  • Research `Range.Find` and then `Range.Resize` perhaps. – BigBen Nov 17 '20 at 00:13
  • At least show what you tried then we can help\explain why that is not working and send you in the correct path. Actually you are not providing anything to help you, we are not going to the work for you instead we'll try to help you gain knowledge, but yet again it depends on you. – EEM Nov 17 '20 at 00:43
  • You're right, I think i tried 10+ different methods and couldn't get anything close so kept deleting them. I'll construct my questions better in the future. – FBeckenbauer4 Nov 17 '20 at 03:14

2 Answers2

0

I think I found my answer, might have to tweak a bit more but if anyone is interested it's taken from this answer: Search for text, copy offset rows

Sub DoYourJob()

Dim readingRow As Long

Dim sourceSheet As Worksheet
Dim destinationSheet As Worksheet

Set sourceSheet = ThisWorkbook.Worksheets("Sheet1")
Set destinationSheet = ThisWorkbook.Worksheets("Sheet2")

For readingRow = 1 To sourceSheet.Cells(sourceSheet.Rows.Count, 2).End(xlUp).row

    If sourceSheet.Cells(readingRow, 5) = Worksheets("Sheet 3").Range("P21") Then

        sourceSheet.Range(sourceSheet.Cells(readingRow + 1, 2), sourceSheet.Cells(readingRow + 55, 6)).Copy (destinationSheet.Cells(5, 1))
        Exit For

    End If

Next readingRow

End Sub
-1

I recommend the following:

Dim sheet1 as Worksheet, sheet2 as Worksheet
Dim row as Integer

Set sheet1 = ThisWorkbook.Sheets(1)
Set sheet2 = ThisWorkbook.Sheets(2)
row = 1

While sheet1.Cells(row, 5).Value <> "Search Text" And row < sheet1.Rows.Count-50
    row = row + 1
Wend

sheet2.Cells(4, 4).Value = sheet1.Cells(row+50, 5).Value

This code can be placed in any subroutine and should work with surrounding code. If this should run on a button trigger, make sure that the subroutine is called when the button is question is pressed.

There are some pretty big edge cases involved, such as "What if the value was not found?". Additional code after the while loop can perform a check to ensure that the value was found, but if you're confident in the environment this will be executing in, it might not be needed.

  • Just wanted to point out some issues with this answer. First, [use `Long` instead of `Integer`](https://stackoverflow.com/questions/26409117/why-use-integer-instead-of-long); then, your loop is a very inefficient approach, and `While...Wend` is old-fashioned and is best avoided. Better alternatives would include `Range.Find` or `Application.Match`. Third, your code doesn't do what OP wants, which is to find the text and copy the next 50 cells underneath. Your code copies a single cell. – BigBen Nov 17 '20 at 01:22