Macro to offset at specific tags and label them based on prior tag

[ExcelAssistance]

Hi guys,

Just looking for a little vba assistance. I'm sure this one has been asked but wasn't sure how to describe it to search for it. Basically if I had a sheet where Column A is populated as follows:

1: Fruits
2: Apples
2: Bananas
2: Pears
1: Vegetables
2: Broccoli
2: Peas

and what I'd like is for the vba to go through the entire column and everytime it finds something with a 1 preceeding it, it looks at all the 2's below and shifts those 2's into column b and places the same 1 grouping in column a...so the above would appear as follows:

1: Fruits 2: Apples
1: Fruits 2: Bananas
1: Fruits 2: Pears
1: Vegetables 2: Broccoli
1: Vegetables 2: Peas

How would I go about doing that? Everything either has a 1 or a 2 before it (they aren't 1's and 2's but they are tags just the same) to define it and ideally I'd also like to strip the tags off as well (and also eliminate the original thing tagged as 1 since it now appears to the left of the item it defines) so really it would just be column a and b looking like

Fruits Apples
Fruits Bananas
Fruits Pears
Vegetables Bananas
Vegetables Peas

Can anybody let me know how to do this? Thanks in advance for any assistance you can give.

 

[Fluff]

What are the actual tags?
Also is there a space between the tag & the value?

 

[ExcelAssistance]

Hi fluff,

Thanks for responding, the tags are

<supportgroup>
<supportid>

And there is a space between the > and the value I'm looking to maintain.

Thanks again.

 

[Fluff]

As I can't see what your tags are try this

Sub RearrangeData()
   
   Dim Ar As Areas
   Dim Rng As Range
   
   With Columns(1)
      .Replace "[COLOR=#ff0000]1:[/COLOR] ", "=X", xlPart, , , , False, False
      Set Ar = .SpecialCells(xlConstants).Areas
      .Replace "=X", "", xlPart, , , , False, False
   End With
   
   For Each Rng In Ar
      Rng.Cut Rng.Offset(-1, 1)
      Rng.Offset(, -1).FillDown
   Next Rng
   Columns(1).SpecialCells(xlBlanks).EntireRow.Delete
   Columns(2).Replace "[COLOR=#ff0000]2:[/COLOR] ", "", xlPart, , , , False, False
End Sub

Replacing the values in red, with your tags.
If you have any problems, please repost what your tags are HTML tags or similar put a space before/after < & >

 

[ExcelAssistance]

Hi Fluff,

Sorry I didn't respond yesterday I was at work and couldn't get back to you. So the first thing and most important part is that after looking at the data (I was going off memory initially) I realize I didn't give the best explanation. I'm including pictures that captures the data as it appears (however I can't share the actual data since it's work sensitive).
I thought I'd try your code anyway because I figured I could tweak it if it got me close enough but I was running into issues with the Rng.Cut Rng.Offset(-1,1) line. Anyway, any additional help you or somebody else can provide would be greatly appreciated.

Please see below for how the data essentially looks and how it should look. Wasn't sure how to post a pic, and unfortunately I'm rushing out the door for work , really really sorry...I have them as imgur links which I recognize isn't ideal and I apologize.

1) How it currently looks:
https://imgur.com/a/cMMq5

2) How it should look after the code is run:
https://imgur.com/a/nVRFo

 

[Fluff]

OK, how about

Sub RearrangeData()
   
   Dim Ar As Areas
   Dim Rng As Range
   
   With Columns(1)
      .Replace "</User Group>", "", xlPart, , , , False, False
      .Replace "<User Group>", "=X", xlPart, , , , False, False
      Set Ar = .SpecialCells(xlConstants).Areas
      .Replace "=X", "", xlPart, , , , False, False
   End With
   Ar(1).EntireRow.Delete
   For Each Rng In Ar
      Rng.Cut Rng.Offset(-1, 1)
      Rng.Offset(, -1).FillDown
   Next Rng
   Columns(1).SpecialCells(xlBlanks).EntireRow.Delete
   Columns(2).Replace "<User ID>", "", xlPart, , , , False, False
   Columns(2).Replace "</User ID>", "", xlPart, , , , False, False
End Sub

 

[ExcelAssistance]

OK so that code doesn't error out like it was yesterday...but it just deletes everything on the sheet.

I'm assuming I'm still putting the tags inside the first set of quotes after the .replace lines, correct?

Sorry, I really appreciate all your help

 

[Fluff]

Apologies, I didn't notice that the board has stripped them out

Sub RearrangeData()
   
   Dim Ar As Areas
   Dim Rng As Range
   
   With Columns(1)
      .Replace "< /User Group >", "", xlPart, , , , False, False
      .Replace "< User Group >", "=X", xlPart, , , , False, False
      Set Ar = .SpecialCells(xlConstants).Areas
      .Replace "=X", "", xlPart, , , , False, False
   End With
   
   For Each Rng In Ar
      Rng.Cut Rng.Offset(-1, 1)
      Rng.Offset(, -1).FillDown
   Next Rng
   Columns(1).SpecialCells(xlBlanks).EntireRow.Delete
   Columns(2).Replace "< User ID >", "", xlPart, , , , False, False
   Columns(2).Replace "< /User ID >", "", xlPart, , , , False, False
End Sub

You'll need to remove the spaces

 

[ExcelAssistance]

No apologies necessary, appreciate all your help.

I'm getting an application-defined or object defined error on the line

Rng.Cut rng.Offset (-1,1)

?

 

[Fluff]

Helps if I save my code before testing & then closing without saving
Try

Sub RearrangeData()
   
   Dim Ar As Areas
   Dim Rng As Range
   
   With Columns(1)
      .Replace "< /User Group >", "", xlPart, , , , False, False
      .Replace "< User Group >", "=X", xlPart, , , , False, False
      Set Ar = .SpecialCells(xlConstants).Areas
      .Replace "=X", "", xlPart, , , , False, False
   End With
 [COLOR=#ff0000]  Ar(1).EntireRow.Delete[/COLOR]
   For Each Rng In Ar
      Rng.Cut Rng.Offset(-1, 1)
      Rng.Offset(, -1).FillDown
   Next Rng
   Columns(1).SpecialCells(xlBlanks).EntireRow.Delete
   Columns(2).Replace "< User ID >", "", xlPart, , , , False, False
   Columns(2).Replace "< /User ID >", "", xlPart, , , , False, False
End Sub