I need a bit help with a task below:
I have source data -
, which are not aligned to table. I would need to find a text (header - e.g. Account) and copy two whole lines, which are below's the searched cell (Account) and paste them on different Sheet. Then search down and do again until the page with data will be ended and data should be pasted chronologically as it is reached.
The cell with word "Account" will be always in the column A, but number of rows will be different. It should also loop for exact word "Account", because in the column can be cells which contain e.g. "Payer account".
I have this code so far and I've stucked a bit, since it shows me an error msg "Run-time error 438 - object doesnt support this property or method"
Private Sub Search_n_Copy() Dim LastRow As Long Dim rng As Range, C As Range With Worksheets("INPUT_2") ' <-- here should be the Sheet's name LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row in column A Set rng = .Range("A1:A" & LastRow) ' set the dynamic range to be searched ' loop through all cells in column A and copy below's cell to sheet "Output_2" For Each C In rng If C.Value = "Account" Then C.Offset(-1, 0).Copy C.Offset.OUTPUT_2(-7, -1) ' use offset to put value in sheet "Output_2", column E End If Next C End With End Sub
Could you help me with it, please?
This post doesn't point out what the error in your original code is. Ron Rosenfeld has already covered that in the comment.
Here is another faster way (as compared to looping) which uses
.Find/.FindNext to achieve what you want. It also doesn't copy the rows in a loop but copies in the end.
Private Sub Search_n_Copy() Dim ws As Worksheet Dim rngCopy As Range, aCell As Range, bcell As Range Dim strSearch As String strSearch = "Account" Set ws = Worksheets("INPUT_2") With ws Set aCell = .Columns(1).Find(What:=strSearch, LookIn:=xlValues, _ LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False) If Not aCell Is Nothing Then Set bcell = aCell If rngCopy Is Nothing Then Set rngCopy = .Rows((aCell.Row + 1) & ":" & (aCell.Row + 2)) Else Set rngCopy = Union(rngCopy, .Rows((aCell.Row + 1) & ":" & (aCell.Row + 2))) End If Do Set aCell = .Columns(1).FindNext(After:=aCell) If Not aCell Is Nothing Then If aCell.Address = bcell.Address Then Exit Do If rngCopy Is Nothing Then Set rngCopy = .Rows((aCell.Row + 1) & ":" & (aCell.Row + 2)) Else Set rngCopy = Union(rngCopy, .Rows((aCell.Row + 1) & ":" & (aCell.Row + 2))) End If Else Exit Do End If Loop Else MsgBox SearchString & " not Found" End If '~~> I am pasting to Output sheet. Change as applicable If Not rngCopy Is Nothing Then rngCopy.Copy Sheets("Output").Rows(1) End With End Sub