VBA to find specific text and cut and past into new worksheet.
DonalK -
May 16, 2017 at 08:57 AM - Latest reply: TrowaD2340
Posts Sunday September 12, 2010Registration dateModeratorStatus
April 19, 2018
Last seen
- May 22, 2017 at 12:04 PM
I am struggling to find anything to help me with my VBA code that I am currently trying to write. I need it to find specific text (Technical date of entry) in column A , once it finds this text I need it to either cut that cell plus the next 2 or 3 cells below it depending on what is in the cell directly below it.
So if it is a number below Technical date of entry) I need it to cut that cell plus the 3 below it.
If it is a date in the cell below technical date of entry I need it to cut that cell plus the 2 below it.
I'm a little confused how many cells you want to cut.
First you say cut the cell with specific text and 2 or 3 cells below.
Then you say look at the cell below specific text and copy that cell (so the one below the specific text) and 2 or 3 cells below. That would mean; don't cut the specific text.
I went with the first one.
Give this code a try:
Sub RunMe()
Dim mFind As Range
Set mFind = Columns("A").Find("Technical date of entry")
If mFind Is Nothing Then
MsgBox "There is no cell found with the text 'Technical date of " _
& "entry' in column A of the active sheet."
Exit Sub
End If
If IsDate(mFind.Offset(1, 0)) = True Then
Range(mFind, Cells(mFind.Row + 2, "A")).Cut
Sheets("Sheet1").Select
Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
ElseIf WorksheetFunction.IsNumber(mFind.Offset(1, 0)) = True Then
Range(mFind, Cells(mFind.Row + 3, "A")).Cut
Sheets("Sheet1").Select
Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
End If
End Sub
Thanks for coming back to me, I have a spread sheet that includes entries like the below, ideally I would like a code to find Technical entry date, if the line below Is a number it would cut row the tech entry row and the next 3 rows below and paste into the next sheet, it the line below the tech entry date is a date I need it to cut the tech entry date and the 2 lines below and paste into the next sheet, I also need this to loop through so that they are all removed from sheet 1 and pasted into sheet 2. Hope that makes sense.
Thank you,
Technical entry date
0011111 Ms Joe Blogs
11/2016 ( 01.11.2016 - 30.11.2016 )
IENDD
Technical entry date
12/2016 ( 01.12.2016 - 31.12.2016 )
IENDD
Quite a few changes. For the code to work make sure your source sheet is called Sheet1 and your destination sheet is called sheet2 (or change those reference in the code).
Give this code a try:
Sub RunMe()
Dim mFind As Range
Set mFind = Columns("A").Find("Technical entry date")
If mFind Is Nothing Then
MsgBox "There is no cell found with the text 'Technical entry date'" _
& " in column A of the active sheet."
Exit Sub
End If
firstaddress = mFind.Address
Do
If IsDate(mFind.Offset(1, 0)) = True Then
Range(mFind, Cells(mFind.Row + 2, "A")).EntireRow.Cut
Sheets("Sheet2").Select
Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
ElseIf WorksheetFunction.IsNumber(mFind.Offset(1, 0)) = True Then
Range(mFind, Cells(mFind.Row + 3, "A")).EntireRow.Cut
Sheets("Sheet2").Select
Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
End If
Sheets("Sheet1").Select
Set mFind = Columns("A").FindNext(mFind)
If mFind Is Nothing Then Exit Sub
Loop While mFind.Address <> firstaddress
End Sub
Thanks for coming back to me, I have a spread sheet that includes entries like the below, ideally I would like a code to find Technical entry date, if the line below Is a number it would cut row the tech entry row and the next 3 rows below and paste into the next sheet, it the line below the tech entry date is a date I need it to cut the tech entry date and the 2 lines below and paste into the next sheet, I also need this to loop through so that they are all removed from sheet 1 and pasted into sheet 2. Hope that makes sense.
Thank you,
Technical entry date
0011111 Ms Joe Blogs
11/2016 ( 01.11.2016 - 30.11.2016 )
IENDD
Technical entry date
12/2016 ( 01.12.2016 - 31.12.2016 )
IENDD