I need to automate the merging of an unspecified number of rows located between asterisks

[lalafresh]

This is very difficult to explain so I will try to demonstrate with screenshots. I just learned how to use macros and find/replace with wildcards about 3 hours ago through google searches, so if anyone mercifully attempts to help me, please speak to me like I'm 5 years old because I have no idea what I'm doing.

I am copying/pasting a schedule from a website into a Word document each day. I have managed to use macros and find/replace to remove a lot of the information I don't need and reformat the rest in a way that makes it easier for me to use. I end up with a plain text document that looks like this (but much longer):

1.png

As you can tell, it's a list of people and their demographic/contact information and other things. The amount of information varies from person to person.

I then use the macro/find-and-replace to add asterisks between each chunk of text, effectively separating each person in the list and their information from the person above and below. Now I am working on automating the action of converting the text to a table with 1 column and as many rows as there are total lines of text, so that I will end up with each line of text in its own row, and a "separator" row containing an asterisk between each person, like this:

2.png

Now.... HERE is where I need help. I am trying to figure out how to automate the merging of the chunk of rows between each asterisk, so the end result will look like this:

3.png



The problem is the number of lines in each group could be 4 or it could be 10. It changes from person to person throughout the document, and from one day to the next.

It doesn't actually matter for my overall purposes whether or not these rows are merged-- I'm trying to do it only because it seems like the easiest way to accomplish what I'm ultimately after, which is a 2nd column on the right side with a blank space that spans the length of each chunk, like so:

4.png

I tried making a 2-column table and just merging the relevant rows in the 2nd column, but it seems like it would be much harder to automate this with a macro. If I can make a 1-column table with every line as a separate row, and with every group separated from each other by something (an asterisk in this case), and I can merge the relevant rows, then I can just do "insert column to the right" and it gives me the blank boxes I'm shooting for.

Any help that anyone can offer would be very much appreciated.

Thank you for reading!

[macropod]

This would be easier to work with if you uploaded a document containing a copy of the content from your first screenshot.

[Guessed]

This looks like a relatively simple task but (as already requested by Macropod) we would need to see the original content. If you are reconstructing dummy data to mimic actual but sensitive content then make sure you use exactly the same end of line markers (carriage returns or soft returns) as are in the original content. Also make sure your dummy data contents instances of all variations that might be encountered in real data.

Note that if you explored terms like 'web scraping' you would see that you can automate the entire process of gathering the source directly from the website and doing the data cleansing in a single macro.

[lalafresh]

Thanks so much for the replies!

Yes, I used dummy data and was only concerned about the final appearance of it, not the things you mentioned, so I will work on that this evening before I upload to be sure it all checks out.

And I assumed there were much simpler, much faster ways of automating this very tedious process, but I feel like I've gone too far down the path of creating this gargantuan macro to turn back now.

[macropod]

Well, if you attach a document to a post containing both some representative content and your macro, we can probably help you with both...

[lalafresh]

The first screenshot below is what I start out with in my internet browser. I use the mouse to select the text and copy it to the clipboard. I highlight the whole table excluding the last cell (bottom right). I can't recall the exact reason for excluding that cell, but at some point along the way it became apparent to me that I needed to do this.

Screenshot 2025-01-15 221304.png

I then open Word and use an assigned keyboard combination to run the macro which pastes the text into the document and formats it as such:

Screenshot 2025-01-15 234357.png

Document version of screenshot above:
ABC.docx

My macro so far:
macro (1).txt

[macropod]

You should be able to reduce your current macro to:

Sub Reformat()
Application.ScreenUpdating = False
With ActiveDocument.Range
  .PasteAndFormat (wdFormatPlainText)
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Wrap = wdFindContinue
    .MatchWildcards = True
    .Forward = True
    .Format = False
    .Text = "Self[!^13]@^13"
    .Replacement.Text = ""
    .Execute Replace:=wdReplaceAll
    .Text = "Portal[!^13]@^13"
    .Execute Replace:=wdReplaceAll
    .Text = "Not reg[!^13]@^13"
    .Execute Replace:=wdReplaceAll
    .Text = "This p[!^13]@^13"
    .Execute Replace:=wdReplaceAll
    .Text = "\(Edit\)"
    .Execute Replace:=wdReplaceAll
    .Text = "[01][0-9]:[03]0 [AP]M"
    .Execute Replace:=wdReplaceAll
    .Text = "#[0-9]{5}[!^13]@^13"
    .Execute Replace:=wdReplaceAll
    .Text = "[FM]\) "
    .Replacement.Text = "^&^l"
    .Execute Replace:=wdReplaceAll
    .Text = "[0-9]{2}[-/][0-9]{2}[-/][0-9]{4}"
    .Replacement.Text = "^13^&"
    .Execute Replace:=wdReplaceAll
    .Text = " " & vbTab
    .Replacement.Text = "*"
    .Execute Replace:=wdReplaceAll
  End With
End With
Application.ScreenUpdating = True
End Sub

For the document as attached, you should be able to use:

Sub Test()
Application.ScreenUpdating = False
Dim Rng As Range
With ActiveDocument.Range
  With .PageSetup
    .TopMargin = InchesToPoints(0.5)
    .BottomMargin = InchesToPoints(0.5)
    .LeftMargin = InchesToPoints(0.5)
    .RightMargin = InchesToPoints(0.5)
    .Gutter = InchesToPoints(0)
  End With
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Wrap = wdFindContinue
    .MatchWildcards = True
    .Forward = True
    .Format = False
    .Text = "^13"
    .Replacement.Text = "^l"
    .Execute Replace:=wdReplaceAll
    .Text = "^l[\*^t]"
    .Replacement.Text = "^p"
    .Execute Replace:=wdReplaceAll
    .Text = "^t"
    .Replacement.Text = ""
    .Execute Replace:=wdReplaceAll
    .Text = "^13^l"
    .Execute Replace:=wdReplaceAll
  End With
  Set Rng = .Duplicate
  With Rng
    .End = .End - 1
    .ConvertToTable Separator:=wdSeparateByParagraphs, NumColumns:=1, AutoFitBehavior:=wdAutoFitFixed
    With .Tables(1)
      .Style = "Table Grid"
      .Columns.Add
      .PreferredWidthType = wdPreferredWidthPercent
      .PreferredWidth = 100
      .Columns(1).PreferredWidth = 100 / 3
      .Columns(2).PreferredWidth = 200 / 3
      .Rows.Alignment = wdAlignRowCenter
    End With
  End With
End With
Application.ScreenUpdating = True
End Sub

Assuming both work as desired, they can be combined into:

Sub Reformat()
Application.ScreenUpdating = False
Dim Rng As Range
With ActiveDocument.Range
  With .PageSetup
    .TopMargin = InchesToPoints(0.5)
    .BottomMargin = InchesToPoints(0.5)
    .LeftMargin = InchesToPoints(0.5)
    .RightMargin = InchesToPoints(0.5)
    .Gutter = InchesToPoints(0)
  End With
  .PasteAndFormat (wdFormatPlainText)
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Wrap = wdFindContinue
    .MatchWildcards = True
    .Forward = True
    .Format = False
    .Text = "Self[!^13]@^13"
    .Replacement.Text = ""
    .Execute Replace:=wdReplaceAll
    .Text = "Portal[!^13]@^13"
    .Execute Replace:=wdReplaceAll
    .Text = "Not reg[!^13]@^13"
    .Execute Replace:=wdReplaceAll
    .Text = "This p[!^13]@^13"
    .Execute Replace:=wdReplaceAll
    .Text = "\(Edit\)"
    .Execute Replace:=wdReplaceAll
    .Text = "[01][0-9]:[03]0 [AP]M"
    .Execute Replace:=wdReplaceAll
    .Text = "#[0-9]{5}[!^13]@^13"
    .Execute Replace:=wdReplaceAll
    .Text = "[FM]\) "
    .Replacement.Text = "^&^l"
    .Execute Replace:=wdReplaceAll
    .Text = "[0-9]{2}[-/][0-9]{2}[-/][0-9]{4}"
    .Replacement.Text = "^13^&"
    .Execute Replace:=wdReplaceAll
    .Text = " " & vbTab
    .Replacement.Text = "*"
    .Execute Replace:=wdReplaceAll
    .Text = "^13"
    .Replacement.Text = "^l"
    .Execute Replace:=wdReplaceAll
    .Text = "^l[\*^t]"
    .Replacement.Text = "^p"
    .Execute Replace:=wdReplaceAll
    .Text = "^t"
    .Replacement.Text = ""
    .Execute Replace:=wdReplaceAll
    .Text = "^13^l"
    .Execute Replace:=wdReplaceAll
  End With
  Set Rng = .Duplicate
  With Rng
    .End = .End - 1
    .ConvertToTable Separator:=wdSeparateByParagraphs, NumColumns:=1, AutoFitBehavior:=wdAutoFitFixed
    With .Tables(1)
      .Style = "Table Grid"
      .Columns.Add
      .PreferredWidthType = wdPreferredWidthPercent
      .PreferredWidth = 100
      .Columns(1).PreferredWidth = 100 / 3
      .Columns(2).PreferredWidth = 200 / 3
      .Rows.Alignment = wdAlignRowCenter
    End With
  End With
End With
Application.ScreenUpdating = True
End Sub

[lalafresh]

Thank you so much for helping me.

If I'm in the "view macros" screen in Word, where do I enter these in at? I'm assuming I paste this somewhere in the editor? When I try to do it as a new macro, I get an error message saying "Ambiguous name detected: Reformat"

[macropod]

If you press Alt-F11 to open the VBA Editor, you could paste them into the document's 'This Document' code module. Don't paste all three in, though; otherwise you'll get the "Ambiguous name detected: Reformat" error message. The idea is to test the first two macros separately and, if they work as desired, replace them with the third one.

[lalafresh]

It worked!!! Thank you SO much!

It really makes no difference for my purposes but it does leave an empty set of parentheses at the end of each section (from around the "(Edit)" link) but I'm sure I can figure that out on my own.

One final question... is it possible to save that 3rd one as a macro with an assigned key that can be triggered inside a blank Word document to paste the contents of the clipboard directly into this format? For instance, the macro I made was assigned the key combo CTRL+SHIFT+W, so I go to the website with the schedule I need and I highlight it and do CTRL+C, then I open a blank Word document and press CTRL+SHIFT+W and it pastes directly into that final format.

Again, thank you so much. I very much appreciate you taking the time to help a stranger on the internet for free.

[macropod]

For the (Edit), change the Find expression to: "\(Edit\)". See edited acro code in my previous post.

As for triggering the macro, you can assign a shortcut key to it - you could even re-assign your CTRL+SHIFT+W shortcut to it.

[lalafresh]

Working like a charm now! I just needed to record a new macro and assign the shortcut to it, then press CTRL+V (after having copied the relevant data to the clipboard), then run the macro you made, and voila! So now the new macro is:

Sub Macro1()
'
' Macro1 Macro
'
'
Application.Run MacroName:="Reformat"
End Sub

Many thanks!!!!

[macropod]

So why are you calling the Reformat macro from another one? That makes no sense at all to me.

[lalafresh]

I couldn't figure out any other way to make it work. I just learned about macros the other day and only know how to make them by recording my actions using keyboard shortcuts. I haven't used the editor and couldn't figure out where to paste the ones you made without getting errors. Somehow I managed to save the 3rd one and assign a keyboard shortcut to it, but it didn't do anything when I copied the table data to the clipboard, opened a blank document and pressed the shortcut keys.

[macropod]

In that case, you should read: Installing Macros