# Word VBA - replace I to n with 1 to n

in VBA

I am a beginer, obviously and I need a little help with this situation:

In a text like:

Article I:

(the text of the article)

Article II:

(the text of the article)

...

Article n:

(the text of the article)

I need a macro to replace Article I: to Article n: with Art. 1 to Art. n so the end result is

Art. 1

(the text of the article)

Art. 2

(the text of the article)

...

Art. n

(the text of the article)

If you have any idea how to do that, I would greatly appreciate it, because we have texts that have a few articles and texts that have thousands of articles and it is hell to replace each one.

Thank you!

+1 vote
by Skilled (670 points)
selected by

This macro assumes there are no spaces or other characters after the colon in Article I: or Article II: or etc., and it assumes that Art. numbers are consecutive starting at 1. Any sentence that includes text like Article I: or Article II: or etc. must have a space or other character after the colon; otherwise, that text might be converted inappropriately.

``````Sub ArticleToArt()
n = 0
i = 1
With ActiveDocument
Do While i <= (.Words.Count - 2)
If .Words(i).Text = "Article " And .Words(i + 2).Text = ":" Then
n = n + 1
.Words(i + 2).Delete
.Words(i + 1).Delete
.Words(i).Text = "Art"
.Words(i).InsertAfter ". " & CStr(n)
i = i + 3
Else
i = i + 1
End If
Loop
End With
End Sub
``````

by Beginner (5 points)

Thank you very much! by Beginner (0 points)
I have the same problem only that I need Article I: to be Art. I and Article 1: to be Art. 1!

It would help me a great deal, thank you
by Skilled (670 points)
The previous macro will work for that, too.
by Skilled (670 points)
edited by

This works better than my previous answer. The previous assumptions are no longer necessary.

``````Sub ArticleToArt()
' Replace Article N or Article N: with Art. A where N is Roman Numeral or Arabic and A is Arabic
Dim i As Integer, s As String, n As Long
Const sBefore As String = "Article "
Const sAfter As String = "Art. "
i = 1
With ActiveDocument
' or With Selection instead of ActiveDocument
Do While i <= (.Words.Count - 2)
If Left(.Words(i).Text, Len(sBefore)) = sBefore Then
s = Trim(.Words(i + 1).Text)
If IsNumeric(s) Then
n = CLng(s)
Else
n = RomanToArabic(s)
End If
If n > 0 Then
s = sAfter & n
If Left(.Words(i + 2).Text, 1) = ":" Then
s = s & Mid(.Words(i + 2).Text, 2)
.Words(i + 1).Text = .Words(i + 1).Text & " "
.Words(i + 2).Delete
End If
s = s & Space(Len(.Words(i + 1).Text) - Len(Trim(.Words(i + 1).Text)))
.Words(i + 1).Delete
.Words(i).Text = s
End If
End If
i = i + 1
Loop
End With
End Sub

Function RomanToArabic(ByVal roman As String) As Long
' Return the Roman Numeral converted to Arabic, or zero if error
' see https://www.vb-helper.com/howto_roman_arabic.html
Dim i As Integer, ch As String, result As Long
Dim new_value As Long, old_value As Long
roman = UCase(roman)
old_value = 1000
For i = 1 To Len(roman)
ch = Mid(roman, i, 1)
' What is this character worth
Select Case ch
Case "I": new_value = 1
Case "V": new_value = 5
Case "X": new_value = 10
Case "L": new_value = 50
Case "C": new_value = 100
Case "D": new_value = 500
Case "M": new_value = 1000
Case Else: RomanToArabic = 0: Exit Function
End Select
' Is this character bigger than previous
If new_value > old_value Then
' Add this and subtract 2*previous
result = result + new_value - 2 * old_value
Else
result = result + new_value
End If
old_value = new_value
Next i
RomanToArabic = result
End Function

``````

by Beginner (5 points)
Hey, thank you for your help, works great for what I need.

I think that Legal _Crazy meant to ask how to write the macro keeping roman numerals roman and arabic numerals arabic and just change Article into Art. and remove the ":" at the end, no matter how many articles there are in a text.

Anyway, you are kind to help us!
{"ft_lang_label":"__label__en","ft_lang_prob":0.9422549,"math_prob":0.9034804,"size":604,"snap":"2020-24-2020-29","text_gpt3_token_len":155,"char_repetition_ratio":0.23,"word_repetition_ratio":0.06666667,"special_character_ratio":0.2665563,"punctuation_ratio":0.15862069,"nsfw_num_words":0,"has_unicode_error":false,"math_prob_llama3":0.97735596,"pos_list":[0,1,2,3,4],"im_url_duplicate_count":[null,3,null,3,null],"WARC_HEADER":"{\"WARC-Type\":\"response\",\"WARC-Date\":\"2020-05-28T11:41:46Z\",\"WARC-Record-ID\":\"<urn:uuid:9d6fc923-40f3-472d-af98-6b8ac2eca634>\",\"Content-Length\":\"41806\",\"Content-Type\":\"application/http; msgtype=response\",\"WARC-Warcinfo-ID\":\"<urn:uuid:bc1ea798-b206-4ffc-8f3f-4cfe1ba6eec1>\",\"WARC-Concurrent-To\":\"<urn:uuid:ccb8efcc-6554-41a9-bc7a-334a480a331c>\",\"WARC-IP-Address\":\"108.61.128.89\",\"WARC-Target-URI\":\"https://ask.wellsr.com/740/word-vba-replace-i-to-n-with-1-to-n?show=753\",\"WARC-Payload-Digest\":\"sha1:3EZACSE5IMAQIACE2YQJ4ZWRXPCWMEUC\",\"WARC-Block-Digest\":\"sha1:N4R5QAN4WR4AC5XV4R7EPK5R7MRJ7NVT\",\"WARC-Identified-Payload-Type\":\"text/html\",\"warc_filename\":\"/cc_download/warc_2020/CC-MAIN-2020-24/CC-MAIN-2020-24_segments_1590347396089.30_warc_CC-MAIN-20200528104652-20200528134652-00172.warc.gz\"}"}