r/vba

I just "finished" my program. Well, finished is a big word. There are always things to be changed.

Since there is a lot of code in it, i thought: Lets share the figures.
How big are your largest progams written in VBA?

My program is semi ERP, only for making offers for a painting company.
It holds:
Login/logout with 3 groups of users; regular, manager and admin all with their own settings
Customer records; add, edit and delete customers
Offer records; create, modify and delete
Set offer status to: cancelled, revised, planned, and finshed.
A memo/task manager so co-workers can see or get a to do list.
Also automated tasks for offer followup
Can print on customers owm paper (with head and footer) of on plain white paper
Search all offers with a specific status/multiple statusses
Agenda function to see the planned offers
Show all offers that are planned to fullfill and see the amount involved with it
Capable of having 5 users working on it at the same time
Auditlog
Helpfunction (99 helptopics) with images about the related topic
And a lot more, but that's detail

It stores absolute 0 data in the main file, it uses 7 different excel sheets to store and read the data.

I think about 75% is ChatGPT, the rest is handwritten.

Statistics of my project:

Code Statistics

• Total lines of VBA source code: 94,381
• Net lines of code (excluding comments, blank lines, and attributes): 45,662
• Total procedures (Subs, Functions, and Properties): 886

VBA Project Components

• Standard modules (.bas): 43
• UserForms (.frm): 30
• Class modules (.cls): 2
• Workbook and worksheet modules: 3

Total VBA components: 78

Code Distribution

• Actual code: 48.4%
• Comments, blank lines, and attributes: 51.6%

I have managed to put together a code which finds specific text and replaces it with other text. However, I also need it to insert a paragraph before and after the replaced word.

It would look like:

From:

Smth
ToBeReplacedWord
Smth

To:

Smth

Replacement

Smth

My current code is below. Any help would be appreciated.

Option explicit

Sub smth()

Dim sarr as Variant
Dim wat as Object
Dim wa as Object
Dim wd as Object
Dim i as Integer
Dim j as Integer
Dim fn as String
Dim fp as String

sarr = Range("A1").CurrentRegion

fn = dir(Filepath & "\*" & Range("F2").Value &"\*", vbNormal)

fp = Filepath & fn

j= Ubound(sarr, 1)

On Error Resume Next
Set wat = GetObject(, "Word. Application")
Select case true
Case Err.Number <> 0
Set wa = CreateObject("Word. Application")
wa.Visible = true
Set wd = wa.Document.Open(fp)
Case wat = "Microsoft Word"
Set wd = wat.Document.Open(fp)
End select

For i = 1 to j
With wd.Content.Find
.Text = sarr(i, 1)
.ReplacementText = sarr(i, 2)
.MatchWholeWord:=true
.Wrap = 1
.Execute Replace:=1
End with
Next i

Set wat = Nothing
Set wa = Nothing
Set wd = Nothing

End Sub

I found this code below to find and replace words that are stored in a table in a separate document.

What i wish to do is to find and replace only after where the cursor is, instead of running through the entire document. How can the code be modified?

Sub CleanUp()

' ReplaceFromTableList Macro

' from Doug Robbins, Word MVP, Microsoft forums, Feb 2015, based on another macro written by Graham Mayor, Aug 2010

Dim oChanges As Document, oDoc As Document

Dim oTable As Table

Dim oRng As Range

Dim rFindText As Range, rReplacement As Range

Dim i As Long

Dim sFname As String

'Change the path in the line below to reflect the name and path of the table document

sFname = "C:\Users\Me\Documents\CleanUp.docx"

Set oDoc = ActiveDocument

Set oChanges = Documents.Open(FileName:=sFname, Visible:=False)

Set oTable = oChanges.Tables(1)

For i = 1 To oTable.Rows.Count

Set oRng = oDoc.Range

Set rFindText = oTable.Cell(i, 1).Range

rFindText.End = rFindText.End - 1

Set rReplacement = oTable.Cell(i, 2).Range

rReplacement.End = rReplacement.End - 1

Selection.HomeKey wdStory

With oRng.Find

.ClearFormatting

.Replacement.ClearFormatting

.MatchWildcards = True

.MatchCase = False

.MatchWholeWord = True

.Text = rFindText.Text

.Replacement.Text = rReplacement.Text

.Forward = True

.Wrap = wdFindContinue

.Execute Replace:=wdReplaceAll

End With

Next i

oChanges.Close wdDoNotSaveChanges

End Sub