Finding a string and then copy/pasting it 3 rows up and one column to the right

[jconkl02]

I have a log file from equipment at my job that I am trying to organize to make it a more useful to me. I want to look through over 5000 rows in column A and when it finds a cell with the words "BHS ASSOCIATION FULLY AVAILABLE", it cuts it out and then paste it 3 rows up and one column over in B. Basically in column B directly across from the row in column A that has "REPT:CELL" in it.

Here is an example of the output from my log file that I pasted into column A.

58 REPT:CELL 945 CDM 2, CRC, HEH

SUPPRESSED MSGS: 0

ERROR TYPE: ONEBTS MODULAR CELL ERROR

SET: MLG-BHS ASSOCIATION FULLY AVAILABLE

MLG 1 DCS 2, SM 14, PSU 0, BHS 1

01 05 02 00 00 01 01 00

01 00 00 00 02 0E 01 00

00 00 00 00 01 10 20 03

00 00 00

10/11/18 02:58:41 #239639

59 REPT:CELL 1025 CDM 1, CRC, HEH

SUPPRESSED MSGS: 0

ERROR TYPE: ONEBTS MODULAR CELL ERROR

SET: MLG-BHS ASSOCIATION FULLY AVAILABLE

MLG 1 DCS 2, SM 12, PSU 0, BHS 1

01 05 02 00 00 01 01 00

01 00 00 00 02 0C 01 00

00 00 00 00 01 10 10 01

00 00 00

10/11/18 02:59:02 #240536

<tbody>
</tbody>

 

[gallen]

Hello this does as you ask.

Note that I've started searching from row 4 in column A as anything before that can't be moved up 3 rows...

Sub FindAndMove()
    Dim c As Range
    Dim sFind As String
    
    sFind = "*BHS ASSOCIATION FULLY AVAILABLE*"
    
    For Each c In Range("A4:A" & Range("A" & Rows.Count).End(xlUp).Row)
        If c Like sFind Then
            c.Cut Cells(c.Row - 3, c.Column + 1)
        End If
    Next c
End Sub

 

[Peter_SSs]

Here is another option for you to try in a copy of your workbook.

Sub MoveUpAndOver()
  With Range("A1", Range("A" & Rows.Count).End(xlUp))
    .Offset(, 1).Value = Evaluate(Replace("if(isnumber(search(""BHS ASSOCIATION FULLY AVAILABLE"",#)),#,"""")", "#", .Offset(3).Address))
  End With
End Sub