find words in a row and format

Good Morning,

I have a single row with data that contains fruits and weather they are fresh or canned. I would like to find all the occurences that start with letters ap and then format in columns.
For example:
apple fresh
appricot canned
I can find the words, but do not know how to get it in columns.
Any help is appreciated.
Thank you.
codedreaner

Can you post a sample file?

This is an example of how it looks and how I would like it to be formatted.
Thank you,
codedreaner

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.eileenslounge.com/viewtopic.php?f=44&t=40455&p=313035#p313035
https://www.eileenslounge.com/viewtopic.php?f=18&t=40411&p=312889#p312889
https://www.eileenslounge.com/viewtopic.php?f=18&t=40411&p=312886#p312886
https://www.eileenslounge.com/viewtopic.php?f=18&t=40411&p=312752#p312752
https://www.eileenslounge.com/viewtopic.php?f=18&t=40411&p=312734#p312734
https://www.eileenslounge.com/viewtopic.php?f=18&t=40411&p=312727#p312727
https://www.eileenslounge.com/viewtopic.php?f=18&t=40411&p=312724#p312724
https://www.eileenslounge.com/viewtopic.php?f=44&t=40374&p=312535#p312535
https://www.eileenslounge.com/viewtopic.php?p=312533#p312533
https://www.eileenslounge.com/viewtopic.php?f=44&t=40373&p=312499#p312499
https://www.youtube.com/watch?v=jTmVtPHtiTg&lc=Ugy_RiNN_kAqUvZ8W994AaABAg. 9xhyRrsUUOM9xpn-GDkL3o
https://www.youtube.com/watch?v=jTmVtPHtiTg&lc=Ugy_RiNN_kAqUvZ8W994AaABAg
https://www.youtube.com/watch?v=jTmVtPHtiTg&lc=UgzlC5LBazG6SMDP4nl4AaABAg
https://www.youtube.com/watch?v=jTmVtPHtiTg&lc=UgzlC5LBazG6SMDP4nl4AaABAg. 9zYoeePv8sZ9zYqog9KZ5B
https://www.youtube.com/watch?v=jTmVtPHtiTg&lc=Ugy_RiNN_kAqUvZ8W994AaABAg. 9xhyRrsUUOM9zYlZPKdOpm
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA

Give this macro a try...

Code:

---

Sub RearrangeFruits()
  Dim X As Long, LastColumn As Long, Arr As Variant
  Const StartCell As String = "K1"
  Const StartOutputCell As String = "A4"
  LastColumn = Cells(Range(StartCell).Row, Columns.Count).End(xlToLeft).Column
  Arr = Range(StartCell, Cells(Range(StartCell).Row, LastColumn))
  Range(StartOutputCell).Resize(, 2).Value = Array("Fruit", "Quantity")
  For X = 1 To UBound(Arr, 2) Step 5
    With Range(StartOutputCell)
      .Offset(Int(1 + (X - 1) / 5), 0) = Arr(1, X + 1)
      .Offset(Int(1 + (X - 1) / 5), 1) = Arr(1, X + 3)
      .Offset(Int(1 + (X - 1) / 5), 2) = Arr(1, X + 4)
    End With
  Next
End Sub

---

NOTE: You will need to adjust the two constants (the Const statements) to reflect your actual start of data (I used K1 and A4 because that is where you showed them to be in your sample file).

Thank you so much. It did work!
I would like to know if you can explain this line to me?
LastColumn = Cells(Range(StartCell).Row, Columns.Count).End(xlToLeft).Column
Thanks again,

codedreaner

I went through it several times, I understand now.
Thanks again,

codedreamer