Thank you Paul. that works perfectly and is almost what I want.
I am trying to merge them into one macro. If I run them independently they work perfectly.
If I remove the End Sub from one and the Sub from the next they look to mould into one but only the first gets performed.
I have tried a few ways to get them to work as one file but without any luck.
this is the full file. I have left a gap between the two files you sent me and just removed the Sub <name> End Sub lines
Code:
Sub bbtoword()
'
' bbtoword Macro
' Macro created 01/04/2018 by Bob
'
Application.ScreenUpdating = False
With Selection.Range
With .Find
.ClearFormatting
.Replacement.Text = "\1"
.Format = False
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = True
.Replacement.ClearFormatting
.Text = "\[b\](*)\[/b\]"
.Replacement.Font.Bold = True
.Execute Replace:=wdReplaceAll
.Replacement.ClearFormatting
.Text = "\[i\](*)\[/i\]"
.Replacement.Font.Italic = True
.Execute Replace:=wdReplaceAll
.Replacement.ClearFormatting
.Text = "\[u\](*)\[/u\]"
.Replacement.Font.Underline = True
.Execute Replace:=wdReplaceAll
.Replacement.ClearFormatting
.Text = "\[color=blue\](*)\[/color\]"
.Replacement.Font.ColorIndex = wdBlue
.Execute Replace:=wdReplaceAll
.Text = "\[color=red\](*)\[/color\]"
.Replacement.Font.ColorIndex = wdRed
.Execute Replace:=wdReplaceAll
.Text = "\[color=#0040FF\](*)\[/color\]"
.Replacement.Font.ColorIndex = wdGreen
.Execute Replace:=wdReplaceAll
End With
End With
Application.ScreenUpdating = True
Application.ScreenUpdating = False
Dim RngSel As Range, RngTmp As Range, i As Long, j As Long
With Selection
Set RngSel = .Range
With .Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "\[list=[0-9]\]*\[/list\]"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
.Execute
End With
Do While .Find.Found
If .InRange(RngSel) = False Then Exit Do
i = CLng(Split(Split(.Text, "]")(0), "=")(1)) - 1
j = 0
Set RngTmp = .Duplicate
With .Duplicate
.Paragraphs.First.Range.Text = vbNullString
.Paragraphs.Last.Range.Text = vbNullString
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "\[\*\]"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
.Execute
End With
Do While .Find.Found
j = j + 1
If .InRange(RngTmp) = False Then Exit Do
.Text = i + j & ". "
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
End With
RngSel.Select
Set RngSel = Nothing: Set RngTmp = Nothing
Application.ScreenUpdating = True
End Sub
This is the file I am using for the tests. It works when I run the files independently.
HTML Code:
[b]How to empty your[color=#0040FF] Temporary Files [/color] and [color=#0040FF]Temporary Internet files [/color] using[color=#0040FF] Disk Cleanup. [/color] [/b]
[list=1]
[*]Go to and click on the [b][color=#0040FF]start [/color][/b]button on the left of the task bar.
[*]Click on [b][color=#0040FF]all programs[/color][/b] then [b]
[color=#0040FF]accessories/system tools/Disk Cleanup.[/color][/b]
[*]If prompted, select the drive that you want to clean up, and then select OK.
[*]Wait for the box to complete a search, this may be a while depending on the size of the drive.
[*]Once the search is complete a new box will open.
[*]Put a tick in the boxes [b][color=#0040FF]Temporary Files [/color] and [color=#0040FF]Temporary Internet files[/color][/b]
[*]Uncheck the tick in any other boxes.
[*]Click [b]OK.[/b]
[/list]
Is it possible to combine them and what am I missing?
Are you sure 0040FF is red? I in fact got mixed up between the green we use for comments to each other on the forum and the wording of my test piece, the colour is blue on the forum?
Thanks.