Find value X in columnA and paste entire row above value Y in columnA

[anrichards22]

I am attempting to write a macro that will find a value (BCode) in column A and cut and paste the entire row in the row above value Class.


Value BCode is always below value Class.

For each Class there is always a BCode.

There can be from 1 to 38 pairs of Class and BCode in any given sheet.

The number of rows between Class and BCode is NOT constant.

I would like the macro the loop through column A and paste the row with value Bcode in the row above value Class...sometimes the destination row is empty sometimes it is not. I do not want any data overwritten so if the row is not empty I need to insert a row for the data.

Sample workbook attached with the before and after.

Any assistance appreciated.

Thx

[anrichards22]

So many gurus so few answers???

[Osvaldo Palmeiro]

Hello. Try this code and see if it could help you.

Sub MoveCodeLine()
Dim countClass As Long, classLine As Long, codeLine As Long
Dim k As Long, x As Long, y As Long

Application.ScreenUpdating = False
countClass = Application.CountIf([A:A], "Class")
 Do While k < countClass
  classLine = [A:A].Find(what:="Class", after:=Cells(classLine + 1, 1)).Row
   codeLine = [A:A].Find(what:="Code", after:=Cells(classLine, 1)).Row
    Rows(codeLine).EntireRow.Copy
   Rows(classLine).EntireRow.Insert
  Rows(codeLine + 1).EntireRow.ClearContents
  k = k + 1
 Loop
  
  x = 1
  y = 1
   Do
    y = Cells(x, 1).End(xlDown).Row
    x = Cells(y, 1).End(xlDown).Row
     If Cells(x, 1).Value = "" Then Exit Sub
      If x - y = 2 Then
      Rows(x - 1).Insert
      x = y + 3
     ElseIf x - y > 3 Then
      Range(Cells(y + 3, 1), Cells(x - 1, 1)).EntireRow.Delete
      x = y + 3
     End If
   Loop

Application.ScreenUpdating = True
End Sub

[anrichards22]

Thank you so much Osvaldo, I have been looking for a solution for months....your code works perfectly!!

[Osvaldo Palmeiro]

Hi, Richards.
I´m glad it helped.
Thanks for the feedback.