Find a value and then copy cells relative to the value

[daithiboy]

Hi All,

I regularly receive a rather poorly put together spreadsheet and I am putting together some macros to make it usable!

I've run into an issue where there is a merged title row that will always contain the word "Clinic". This row number can change regularly. The rows that I wish to copy start two rows below the title row.

I have been trying to write a macro which will search for "*Clinic*" and then offset down by two rows and copy everything from there to the last row, but have failed miserably

I hope someone can help as I have wasted quite a bit of office hours with this today!!

Many thanks in advance.
Dave

 

[mumps]

This macro will copy the range to Sheet2.

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim ClinicRow As Long
    ClinicRow = ActiveSheet.UsedRange.Find("Clinic", LookIn:=xlValues, lookat:=xlPart).Row
    Dim lCol As Long
    lCol = ActiveSheet.UsedRange.Columns.Count
    Range(Cells(ClinicRow + 2, 1), Cells(LastRow, lCol)).Copy Sheets("Sheet2").Cells(1, 1)
    Application.ScreenUpdating = True
End Sub

 

[Yongle]

Try this

does it find the correct cell

Sub TestThis()
    Dim cel As Range:       Set cel = ActiveSheet.Cells.Find("*clinic*")
    MsgBox cel.Address
End Sub

How many rows need copying and where are they pasted?

 

[daithiboy]

Many thanks mumps, that worked a treat. I can fiddle with the copy and paste to suit myself.

Yongle - That code found the correct cell - Many thanks.

 

[Yongle]

Thanks for feedback
This sets up the copy for you, you just need to add the paste instruction

Sub CopyRows()
    Dim r As Long
    With ActiveSheet
        r = .Cells.Find("*clinic*").Row + 2
        .Range("A" & r, .Range("A" & Rows.Count).End(xlUp)).EntireRow.Copy
    End With
End Sub

 

[Yongle]

I should have added in that last post
- uses column A to determine last row. Amend that to whichever column is appropriate

 

[daithiboy]

Mumps, Yongle,

Using your either of your find methods. How would I write the code to do the following:

If "clinic" is found then change the value of the cell which is two rows below and in column 8 i.e. If "Clinic" is found in cell A9 then I would like it to set the value of cell H11 to "Regular".

Any thoughts?

 

[Yongle]

Sub CopyRows()
    Dim r As Long
    With ActiveSheet
        r = .Cells.Find("*clinic*").Row + 2
        .cells(r, "H").Value= "Regular"
        .Range("A" & r, .Range("A" & Rows.Count).End(xlUp)).EntireRow.Copy
    End With
End Sub

assumes column A determines last row


Do you need error handling?
- is there a risk that "clinic" will not be found?

 

[mumps]

Do you want to change the cell to "Regular" before copying the range to Sheet2 so that it is included in the copied range?

 

[daithiboy]

Thanks a mil Yongle. Yes mumps that would be ideal and then also autofill down column H.