How to find specific text and then copy the values below it

[RookieExcel22]

Hi,

I have text "Comp43" that should always be in A4, but rarely could be in another cell such as A6 or B5 etc. I am hoping there is a way for VBA to find the cell that this value is in and then copy all of the data below it? For example if it appears in A4, it would copy paste from A5 to the last row. If it appears in B5, it would copy from B6 to the last row, etc.

Thank you!

 

[mse330]

Hi .. Try below code

Sub test()

Dim Rg As Range, Lr&

With Sheets("Sheet1")
   Set Rg = .UsedRange.Find("Comp43", lookat:=xlWhole)
   If Rg Is Nothing Then
      MsgBox "Nohting found in " & .Name & ", macro will stop", vbExclamation
      Exit Sub
   End If
   Lr = Cells(Rows.Count, Rg.Column).End(3).Row
   Rg.Resize(Lr - Rg.Row + 1).Copy
   ' data is copied, you can paste it as desired
End With

End Sub

 

[RookieExcel22]

Hi .. Try below code

Sub test()

Dim Rg As Range, Lr&

With Sheets("Sheet1")
   Set Rg = .UsedRange.Find("Comp43", lookat:=xlWhole)
   If Rg Is Nothing Then
      MsgBox "Nohting found in " & .Name & ", macro will stop", vbExclamation
      Exit Sub
   End If
   Lr = Cells(Rows.Count, Rg.Column).End(3).Row
   Rg.Resize(Lr - Rg.Row + 1).Copy
   ' data is copied, you can paste it as desired
End With

End Sub

Is there a way to not include the "Comp43" cell? Just everything below it? Also how do I expand the range if I wanted to grab everything below and to another column?

 

[Tom.Jones]

Small change in mse330 code:

Sub test()

Dim Rg As Range, Lr&

With Sheets("Sheet1")
   Set Rg = .UsedRange.Find("Comp43", lookat:=xlWhole)
   If Rg Is Nothing Then
      MsgBox "Nohting found in " & .Name & ", macro will stop", vbExclamation
      Exit Sub
   End If
   Lr = Cells(Rows.Count, Rg.Column).End(3).Row
   Rg.Offset(1).Resize(Lr - Rg.Row + 1).Copy
   ' data is copied, you can paste it as desired
End With

End Sub

 

[mse330]

Use .Resize(,5) to extend your selection by 5 columns (or adjust as needed

Rg.Offset(1).Resize(Lr - Rg.Row + 1,5).Copy

 

[RookieExcel22]

Small change in mse330 code:

Sub test()

Dim Rg As Range, Lr&

With Sheets("Sheet1")
   Set Rg = .UsedRange.Find("Comp43", lookat:=xlWhole)
   If Rg Is Nothing Then
      MsgBox "Nohting found in " & .Name & ", macro will stop", vbExclamation
      Exit Sub
   End If
   Lr = Cells(Rows.Count, Rg.Column).End(3).Row
   Rg.Offset(1).Resize(Lr - Rg.Row + 1).Copy
   ' data is copied, you can paste it as desired
End With

End Sub

Perfect, thank you.

 

[RookieExcel22]

Use .Resize(,5) to extend your selection by 5 columns (or adjust as needed

Rg.Offset(1).Resize(Lr - Rg.Row + 1,5).Copy

Of course! Thank you!