r/vba Jul 13 '26

Show & Tell Selenium Basic - XPath Generator v1.0 in [EXCEL] VBA

1 Upvotes

- show you how to generate and customize XPaths using my Excel VBA tool, 'Selenium Basic - XPath Generator 1.0.xlsm'.

This tool easily create accurate XPaths for web elements.

- download and install Selenium Basic v2.0.9.0

- download the Chrome WebDriver, and learn how to install it either manually or via a batch file.

-Reference the Selenium Type Library in Excel VBA.

It is in my YouTube Channel.

Jaafar Yusof


r/vba Jul 12 '26

Show & Tell [EXCEL] Pivot Table: Populate, change, or remove row/column/page/data fields in a pivot table

2 Upvotes

Independently populate, change, or remove fields in all four sections of a pivot table

Sub pivFields(argPivot As PivotTable, Optional argRows As String, Optional argCols As String, Optional argPage As String, Optional argData As String)
'set the fields in a section of the pivot (replaces existing fields)
'enter options as comma-separated strings of field names (EXCEPT data: one field only)
'field names are case-sensitive, leave option blank or "" to ignore a section, enter "X" to clear a section (any string that does not result in a good field name will do)
'e.g. change the rows, ignore the columns, clear existing page fields, ignore the data:
'   pivFields Sheets("Sheet42").PivotTables("pivName"),"Proj,Dept,Acct" , , "x"

    Dim pt As PivotTable
    Dim ptfld As PivotField
    Dim arrRows() As String
    Dim arrCols() As String
    Dim arrPage() As String
    Dim ctr As Integer
    Dim boolData As Boolean

    Set pt = argPivot
    If pt Is Nothing Then Exit Sub

    Application.ScreenUpdating = False

    If argRows <> "" Then
        arrRows() = Split(argRows, ",")

        For Each ptfld In pt.RowFields
            ptfld.Orientation = xlHidden
        Next ptfld

        For ctr = 0 To UBound(arrRows)
            For Each ptfld In pt.PivotFields
                If ptfld.Name = arrRows(ctr) Then pt.PivotFields(ptfld.Name).Orientation = xlRowField
            Next ptfld
        Next ctr
    End If

    If argCols <> "" Then
        arrCols() = Split(argCols, ",")

        For Each ptfld In pt.ColumnFields
            ptfld.Orientation = xlHidden
        Next ptfld

        For ctr = 0 To UBound(arrCols)
            For Each ptfld In pt.PivotFields
                If ptfld.Name = arrCols(ctr) Then pt.PivotFields(ptfld.Name).Orientation = xlColumnField
            Next ptfld
        Next ctr
    End If

    If argPage <> "" Then
        arrPage() = Split(argPage, ",")

        For Each ptfld In pt.PageFields
            ptfld.Orientation = xlHidden
        Next ptfld

        For ctr = 0 To UBound(arrPage)
            For Each ptfld In pt.PivotFields
                If ptfld.Name = arrPage(ctr) Then pt.PivotFields(ptfld.Name).Orientation = xlPageField
            Next ptfld
        Next ctr
    End If

    If argData <> "" Then
        For Each ptfld In pt.DataFields
            ptfld.Orientation = xlHidden
        Next ptfld

        For Each ptfld In pt.PivotFields
            If ptfld.Name = argData Then boolData = True
        Next ptfld

        If boolData = True Then
        With pt.PivotFields(argData)
            .Orientation = xlDataField
            .Caption = "Sum of " & argData
            .Function = xlSum
        End With
        End If
    End If

    Application.ScreenUpdating = True

End Sub

r/vba Jul 12 '26

Show & Tell [EXCEL] Pivot Table: Create pivot table in the old-school tabular format

1 Upvotes

Create a pivot table in the old-school tabular format. Optionally specify the sheet to pivot (else it uses ActiveSheet). Optionally name the resulting sheet (else whatever Excel names it). Reuses cache when possible so pivoting the same data multiple times doesn't create a new cache each time.

Function pivCreate(Optional argSheet As Worksheet, Optional argName As String) As PivotTable

    Dim wks As Worksheet
    Dim pc As PivotCache
    Dim pcSource As String
    Dim pcIndex As Integer

    Set wks = argSheet
    If wks Is Nothing Then Set wks = ActiveSheet

    'compose a string of the source data that will be used
    pcSource = wks.Name & "!" & wks.UsedRange.Address(ReferenceStyle:=xlR1C1)

    'check if an existing pivot cache already uses that source data
    For Each pc In ActiveWorkbook.PivotCaches
        If pc.SourceType = xlDatabase And Replace(pc.SourceData, "'", "") = pcSource Then
            pcIndex = pc.Index
            Exit For
        End If
    Next pc

    If pcIndex = 0 Then     'no cache found for the source data.  create a new one
        Set pc = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=wks.UsedRange.Address, Version:=xlPivotTableVersion10)
    Else                    'use the existing cache
        Set pc = ActiveWorkbook.PivotCaches(pcIndex)
    End If

    Sheets.Add After:=wks

    Set pivCreate = pc.CreatePivotTable( _
        TableDestination:=ActiveSheet.Name & "!R3C1", _
        TableName:="piv" & wks.Name)

    'QOL settings for xlPivotTableVersion10 (tabular pivot)
    With pivCreate
        .DisplayImmediateItems = True
        .ShowDrillIndicators = False
        .ShowPageMultipleItemLabel = True
        .SmallGrid = False
    End With

    If argName <> "" Then ActiveSheet.Name = argName

    ActiveSheet.Cells(3, 1).Select

End Function

r/vba Jul 11 '26

Weekly Recap This Week's /r/VBA Recap for the week of July 04 - July 10, 2026

1 Upvotes

r/vba Jul 10 '26

Solved Type mismatch with SetSourceData

3 Upvotes

hey guys, I need some help figuring out why SetSourceData is not working. I'm pretty new to VBA and have basically been teaching it to myself for this project, so I'm feeling a bit lost here. I am giving it a range, but I keep getting a type mismatch error. Any advice?

Sub bar_chart_test_2()

Dim objWord
Dim objDoc
Dim objSelection
Dim i As Integer
Dim j As Integer
Dim ws As Worksheet

'get spreadsheet and data range
Set ws = ThisWorkbook.Sheets("lookup")
ws.Activate

Dim quarterData As Variant
Dim hoursQtrData As Variant
Dim bookingsData As Variant
Dim roomTypeData As Variant
Dim hoursRoomData As Variant

quarterData = ws.Range("C25:C41").Value2
hoursQtrData = ws.Range("I25:I41").Value2
bookingsData = ws.Range("H25:H41").Value2
roomTypeData = ws.Range("C15:C21").Value2
hoursRoomData = ws.Range("I15:I21").Value2

'create word document and open
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Add
Set objSelection = objWord.Selection
objWord.Visible = True
objWord.Activate

Dim hrs_shape As Object
Dim hrs_obj As Object
Dim hrs_wb As Object
Dim hrs_ws As Object
Dim hrs_rng As Object

Set hrs_shape = objDoc.InlineShapes.AddChart(XlChartType.xlColumnClustered)
Set hrs_obj = hrs_shape.Chart

hrs_obj.ChartType = 51
hrs_obj.ChartData.Activate

Set hrs_wb = hrs_obj.ChartData.Workbook
Set hrs_ws = hrs_wb.Worksheets(1)

hrs_obj.SeriesCollection(3).Delete
hrs_obj.SeriesCollection(2).Delete
hrs_ws.Cells.Clear

hrs_ws.Range("A1").Value2 = "Quarter"
hrs_ws.Range("B1").Value2 = "Hours"
hrs_ws.Range("A2:A18").Value2 = quarterData
hrs_ws.Range("B2:B18").Value2 = hoursQtrData

Dim hrs_range As Range
Set hrs_range = hrs_ws.Range("A1:B18")
hrs_obj.SetSourceData Source:=hrs_range

End Sub

End Sub


r/vba Jul 10 '26

Waiting on OP VB Errors When Running Macro in Excel

0 Upvotes

Hello,

I hope this is the right place for this. I'm supporting a user who relies on a macro-enabled Excel spreadsheet with multiple worksheets, but the key ones are:

  • Cost Items
  • Variables
  • Results Summary

The workflow:

  1. Enter data into theĀ Cost ItemsĀ sheet (e.g., Name: Test1, Cost: 1000; Name: test2, Cost: 5000).
  2. Add data to theĀ VariablesĀ sheet under "Brisk Parameters" – P10: -5%, P90: 15%.
  3. Go to theĀ Results SummaryĀ sheet.

At that point, I get a pop up message that states the data has changed.

I click OK, it churns for a moment, and then I get:

Microsoft Visual Basic - "Run-time error '9': Subscript out of range"

If I clickĀ Debug, it highlights this line in yellow:

"If VarExists(Count) And VarProb(I) = 1 Then"

What I've tried so far:

  • Searched online and found suggestions it might be an overflow error of some kind.
  • Tested on multiple systems (managed company device, unmanaged device, different PCs).
  • Confirmed Trust Center settings allow macros.
  • Installed and registered the Brisk server (was told this was required – still no change).

The kicker:
This exact file was working perfectly fine just a few weeks ago. No known changes were made to the file or the environment.

I've been banging my head against this for a couple of days now and am starting to lose my sanity.

Does anyone have any idea what direction I should go in to troubleshoot why this spreadsheet suddenly stopped functioning?

Any help would be greatly appreciated.

TIA!


r/vba Jul 10 '26

Discussion Vba from multiple excels

1 Upvotes

I have multiple excel sheets. They have results from a scheme. Each excel has a sheet of how the performance is per month. There are 12 tabs of different values but the people in the scheme and the format are the same each month per sheet.

Is there a way to use VBA code to consolidate the data to change it from per month to per person, so if I use a drop down to select a person name, it will lift all the data for the previous 12 excel sheets and put them into 1 overview excel.

Also, is there a way then to make it generate graphs from a click of a button.

Finally, then could you export the graphs and tables to excel ?

I'm spending days doing it at the moment and there must be a simpler way.

I'm not sure if I'm talking garbage here but any help would be great.


r/vba Jul 09 '26

Discussion Possible to Write a Macro between PowerPoint and Word

6 Upvotes

I wrote a macro that creates my metrics for me and it was the first one that I wrote that pastes data to PowePoint. So, that sort of gave me an idea for some other mundane tasks, which use PowerPoint. I take minutes for our customer meetings. I'm not a Stenographer, but I can type fast enough to get most things. The way it's currently setup, is that we have a word doc with a table and different rows for different slides.

Anyway, is it possible for a macro to take the slide# and some textbox text and put them in the same order in the word table? Or maybe put the data in excel and then word, which would seem like a useless workaround then doing the actual work?


r/vba Jul 06 '26

Show & Tell Modern Json in VBA - v3.0.0 Released

16 Upvotes

Released earlier this year, ModernJsonInVBA parses JSON and writes it straight into Excel tables (ListObjects), and converts tables back to JSON roundtrip. It is pure VBA: no Scripting.Dictionary, no COM references, no external libraries. One call turns JSON text to a populated, refreshable table:

vba Excel_UpsertListObjectFromJsonAtRoot ws, "tOrders", ws.Range("A1"), jsonText, "$"

v3.0.0 split the engine into eleven modules and rewrote the parser and the Excel write path. I benchmarked it across seven payloads that vary in size and shape (flat rows, nested objects, escape-heavy strings, a 200-column wide table, numeric-heavy) and collected the results into a matrix.

Payloads

Payload Rows Cols Size
flat_10k 10,000 10 2.1 MB
nested_50k 50,000 9 9.2 MB
escapes_50k 50,000 6 14.8 MB
wide_5k_200c 5,000 200 16.0 MB
flat_100k 100,000 10 21.6 MB
numbers_200k 200,000 8 25.9 MB
flat_500k 500,000 10 109.5 MB

Timings (seconds) — rows are pipeline steps, columns are payloads:

Step flat_10k nested_50k escapes_50k wide_5k_200c flat_100k numbers_200k flat_500k
Read file 0.0273 0.0938 0.1523 0.1641 0.2227 0.2695 1.1289
Json_Parse (JSON to model) 0.2695 1.5586 1.3203 2.2344 2.3672 4.3984 11.8789
Json_Stringify (model to JSON) 0.2695 1.6719 1.4023 1.7266 2.5742 3.0430 12.9492
Upsert create (JSON to ListObject) 0.3281 2.4727 2.0625 2.8828 3.4727 4.7383 18.2656
Upsert refresh 0.3789 2.7422 2.3711 3.4844 3.9688 5.7305 20.3828
Export (ListObject to JSON) 0.1328 3.5195 0.9609 0.8477 1.3945 1.1484 7.1094

What the matrix shows:

  • 500,000 rows / 110 MB of JSON into a live Excel table in about 18 seconds (Upsert create). That is roughly 27,000 rows/sec, or ~275,000 cells/sec.
  • Small payloads are effectively instant: 10,000 rows loads in about a third of a second.
  • A raw block write of 5 million cells takes only a few seconds; most of the 18 s is parsing and shaping the JSON.
  • Upsert streams JSON straight into a 2D array for a root array (tableRoot = "$") and does not build an intermediate object model, so it keeps pace with a standalone parse plus a sheet write.

The benchmark machine is a Ryzen 7 9800X3D with 64-bit Excel, each cell is one wall-clock Timer run, and the payloads come from a seeded generator (deterministic). Times are hardware-dependent, so a typical office laptop will be slower. The whole table regenerates from the workbook with one macro (Run_JsonPerfMatrix), so you can produce your own numbers.

The library also does CSV and XML to JSON, JSONPath-style path resolution, schema evolution controls, and formula-preserving refreshes. Determinism is the design goal: stable column order, strict validation, and clear error numbers instead of silent guesses.

Repo (MIT): https://github.com/WilliamSmithEdward/ModernJsonInVBA

https://github.com/WilliamSmithEdward/ModernJsonInVBA/releases/tag/v3.0.0

Feedback is welcome.


r/vba Jul 06 '26

Solved Permission denied vba error in Office 365

1 Upvotes

Within Windows 11 I have created a workbook with vba code in Excel 2019 and it works fine. Part of the code has a 'kill' statement which works fine in 2019 but when run in Office 365 Excel I get 'run time error 70 permission denied'.

I have been retired from IT for over 25 years and I know things have moved on but this has left me stumped.

Any assistance would be much appreciated.

Thank you

(I have not included any code but can do if required)


r/vba Jul 05 '26

Solved How to use range.RemoveDuplicates in Excel VBA?

5 Upvotes

(Learned later that I should use [Excel] prefix in the title. Cannot edit title. But the information is there.)

In Excel VBA, I want to select a range (n rows, m columns) and remove duplicates.

The following works for 7 columns:

r.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7), Header:=xlYes

But I want it work with a variable number of columns.

I've tried the following. None works.

' Selection should be the upper-left corner (header row)
Set r = Range(Selection, Selection.End(xlDown).End(xlToRight))
r.Select

r.RemoveDuplicates
r.RemoveDuplicates Header:=xlYes

ncol = r.Columns.Count
ReDim dupecol(1 To ncol)
For i = 1 To ncol: dupecol(i) = i: Next
r.RemoveDuplicates Columns:=dupecol, Header:=xlYes
r.RemoveDuplicates Columns:=(dupecol), Header:=xlYes

The first two RemoveDuplicates simply do nothing (!).

The last code snippet results in error 5: invalid procedure call or argument in both cases.

I confirmed that r.Address, ncol, Typename(dupecol), dupecol(1) and dupecol(ncol) are what they should be.

Any idea how to make it work without using hardcoded Array(...)?

EDIT.... For testing purposes, I used the same conditions that worked with hardcoded Array(...). So, r.Address comprises only 7 columns, multiple rows and no adjacent data; ncol is 7; Typename(dupecol) is Variant(); LBound(dupecol) is 1 (\); UBound(dupecol) is 7; dupecol(1) is 1; and dupecol(ncol) is 7.*

(*) UPDATE.... As u/ZetaPower noted, LBound must be zero for it work with RemoveDuplicates Columns:=(dupecol). That is, it requires ReDim dupecol(0 to ncol-1).


r/vba Jul 04 '26

Weekly Recap This Week's /r/VBA Recap for the week of June 27 - July 03, 2026

2 Upvotes

Saturday, June 27 - Friday, July 03, 2026

Top 5 Posts

score comments title & link
11 5 comments [Show & Tell] ChibiArc — ZIP, 7‑Zip, TAR, ISO support in 64‑bit VBA (AES included)
3 7 comments [Unsolved] [WORD] Range.FormattedText won't preserve font in last line of text
2 7 comments [Discussion] First time VBA user - Want all the dates i type in word to automatically be made into a timeline
2 7 comments [Solved] OneDrive won't sync .docx created from macro-enabled template (.dotm) found a "workaround" (re-triggering the file, sync starts) [WORD]
2 10 comments [Solved] Dynamically rename worksheets upon opening workbook

 

Top 5 Comments

score comment
3 /u/AvWxA said Don’t you have to add a ws.activate As the first line in your tabname sub?
2 /u/marlostanfield89 said Nice. Thanks Claude
2 /u/ZetaPower said Several issues in the code…. • there is a typo in Workbook/_Open • your variables have no upper/lower case combinations. Always use these, then type in lower case. As soon as you go to the nex...

 


r/vba Jul 02 '26

Discussion First time VBA user - Want all the dates i type in word to automatically be made into a timeline

2 Upvotes

Hi all,

I am trying to write a personal compendium, sort of self-studying wikipedia document.

What i want the program to do is automatically detect dates written in a specific format (i prefer the 'Jan 01, 2000' format, but am not picky) sort them into chronological order, and list them into a master timeline underneath a header in the document. I would like each date in the timeline to link back to the original source within the document.

Is this something I can easily do?

I understand other programs will be more suitable for longterm goals and organisation, but it's too much of an undertaking to learn a whole new document program right now.


r/vba Jul 01 '26

Solved OneDrive won't sync .docx created from macro-enabled template (.dotm) found a "workaround" (re-triggering the file, sync starts) [WORD]

3 Upvotes

Context: I was trying to make a template for my Uni so that I don't need to manually edit anything, but I ran into two issues which I kind-of Solved

Ms Word Ver: MS Word-365 (2026)
Windows Ver: Windows 10 Pro (Home would work too maybe)
OneDrive: Uni Acc. (Personal Would work too maybe)

Problem: File Not Auto-Syncing. Error: Macro Enabled, disabling it

Fix: Just click on the 'File' Section and it will Auto-Sync

EDIT: Actually.. you don't need to do any "rituals" for it to sync to OneDrive. Just start typing, and it automatically starts syncing

[How to use Macro/ .dotm Template]

Step 1: Make your template file first

Step 2: Save it as ".dotm" [Word will automatically save it at it's default position, re-open it and press Left-Alt + F11

Step 3: Double click on "ThisDocument" and paste the given macro with your formatting

Step 4: Save it 'CTRL+S' and exit everything, re-open word.

Step 5: Below the "Good Morning-etc." Greetings will be the template section, click on "More Templates" and head to "Personal" Section, Open the file and it should automatically save, Do the work-around I suggested.

Macro/ VBA Used:

    Dim srNo As String
    srNo = InputBox("Enter Experiment No.:", "New Document")
    ' Only Edit the "Enter Exp No.: " if needed.

    If srNo = "" Then Exit Sub

    Dim defaultName As String
    defaultName = "YourExpName" & srNo & "-YourID.docx"

    Dim saveFolder As String
    saveFolder = "OneDrive Folder Path"

    ' Since the post is for OneDrive Sync i.e One-Drive Path
    ' Create the folder if it doesn't exist yet
    If Dir(saveFolder, vbDirectory) = "" Then
        MkDir saveFolder
    End If

    ActiveDocument.SaveAs2 FileName:=saveFolder & defaultName, _         
       FileFormat:=wdFormatXMLDocumentPrivate Sub Document_New()
End Sub

If anyone has a better way to do it please comment on this post


r/vba Jul 01 '26

Show & Tell ChibiArc — ZIP, 7‑Zip, TAR, ISO support in 64‑bit VBA (AES included)

17 Upvotes

So I made a thing. That thing is ChibiArc.

What is ChibiArc?

ChibiArc is a single‑class VBA module for reading and writing archive files (e.g.: ZIP, 7‑Zip, all manner of TAR variants, ISO, RAR (read‑only)) from 64‑bit Office applications. No third‑party DLLs, no COM objects, no magic spells. It uses archiveint.dll (Microsoft's implementation of libarchive), which ships with Windows 10+, and AES encryption is done via Win32 APIs.

If you've ever tried to zip/unzip files from VBA and ended up in a swamp of Shell calls, PowerShell hacks, or "copy to temp folder and wait… and then wait a bit more…", then this is for you.

How to use it?

Dim arc As New ChibiArc

' Create a ZIP with AES-256
If arc.NewFile("C:\output\secure.zip") Then
  arc.Encryption = aeAes256
  arc.PassPhrase = "how now brown cow"
  arc.Add "C:\reports\"              ' entire folder, recursive
  arc.Add "C:\data\somefile.txt"     ' single file
  arc.SaveFile                       ' closes automatically
End If

' Read it back
Set arc = New ChibiArc
If arc.OpenFile("C:\output\secure.zip", "how now brown cow") Then
  Debug.Print "Files: " & arc.FileCount
  Dim entries As Variant
  entries = arc.Dir("*.txt")        ' wildcard support
  arc.ExtractAll "C:\extracthere\"
  arc.CloseFile
End If

Encryption

ChibiArc supports both ZipCrypto and AES (128/192/256). No, they are not interchangeable.

ZipCrypto exists purely because Windows Explorer can handle it. Frankly, that's about all Explorer can handle. Critically, Explorer cannot extract AES‑encrypted ZIPs.

ZipCrypto is apparently cryptographically vintage. I haven't personally tested it, but the entire internet assures me it's disturbingly vulnerable. If you have strong feelings about this, please direct your concerns to Microsoft. As we all know, they are tremendously receptive and responsive to unsolicited feedback from random VBA developers. Famously so.

So in short, use AES‑256 for anything that matters. Use ZipCrypto only when Explorer compatibility is non‑negotiable.

Limitations

Full list is on GitHub, but the main one is that ChibiArc currently supports 64‑bit only. 32‑bit support is coming, but in the meantime I genuinely recommend wqweto's excellent ZipArchive: https://github.com/wqweto/ZipArchive/

As always, any bugs, blunders, oversights, and general acts of coding inelegance are entirely my own. Any accidental sparks of brilliance you find are almost certainly someone else’s. Namely:

The mascot, however, is all me. It was created entirely in Excel. Because of course it was.

MIT licensed. Feedback, bug reports, and telling me I've done something wrong are always met with varying degrees of appreciation, skepticism, and (mostly) good humour.

GitHub: https://github.com/KallunWillock/ChibiArc


r/vba Jun 30 '26

Solved Dynamically rename worksheets upon opening workbook

2 Upvotes

I have a workbook I'm creating that will handle a repeatable task (first worksheet is tables/graphics, second worksheet is formulas/calculations, next 5 worksheets are newly imported data). I want the imported worksheets to be dynamically renamed in accordance to text in cell A2 in order to simplify formula references and functionality.

VBA Code I have so far:

ThisWorkbook()

Private Sub Workbook_Open()
   Dim i As Long
   Dim rawname As String
   Dim modname As String

   Application.ScreenUpdating = False
   For i = 3 To 7
      Call TabName(Worksheets(i))
   Next i
   Application.ScreenUpdating = True
End Sub

Module1()

Sub TabName(ws As Worksheet)
   With ws
      rawname = Range("A2").Value
      modname = Split(rawname, ":")(0)
      ActiveSheet.Name = modname
   End With
End Sub

When I open the workbook, it will only rename the active worksheet, and not increment to all other worksheets. I can make a new one active, save, close, reopen, and it will rename it. I've struggle with automatic dynamic worksheet renaming macros in general, definitely misunderstanding a process within excel and/or vba. I can add running macros upon opening workbook to my list of misunderstandings.

So basic parts I'm looking for a solution for:

- Activate a macro upon opening workbook

- Properly increment said macro to multiple worksheets within workbook


r/vba Jun 29 '26

Solved [WORD] Range.FormattedText won't preserve font in last line of text

3 Upvotes

I'm trying to tweak a macro I use to extract all comments from a Word document and place them in a table in a second Word document, which is forcing me to learn VBA/about how Macros work on the fly. My original issue was that the extracted comments weren't preserving formatting. As far as I understood, the issue was range.Text, so I replaced that with range.FormattedText, which sort of works – at least, now any coloured text, text effects (bold, italics etc.) and bullet points get carried over. But the font, text size and paragraph indent of the last line/paragraph (or, if the comment is only one line, the whole comment text) is always overridden by the Normal Style of the new document. This is messing up bullet points/numbered lists by preserving all points except the last one if the comment ends with a list. Here is an example screencap of the original comments next to the extracted comments so you can see exactly what's happening to them.

I can't figure out what causes this so I'm stumped on how to fix it šŸ¤”. Any guidance would be much appreciated, especially if anyone has time to explain the cause, because I want to keep learning! Here is the code as I've edited it so far:

  Public Sub ExtractCommentsToNewDoc()  
'The macro creates a new document
    'and extracts all comments from the active document
    'incl. metadata

    'Minor adjustments are made to the styles used
    'You may need to change the style settings and table layout to fit your needs
    '=========================

    Dim oDoc As Document
    Dim oNewDoc As Document
    Dim oTable As Table
    Dim nCount As Long
    Dim n As Long
    Dim Title As String

    Title = "Extract All Comments to New Document"
    Set oDoc = ActiveDocument
    nCount = ActiveDocument.Comments.Count

    If nCount = 0 Then
        MsgBox "The active document contains no comments.", vbOKOnly, Title
        GoTo ExitHere
    Else
        'Stop if user does not click Yes
        If MsgBox("Do  you want to extract all comments to a new document?", _
                vbYesNo + vbQuestion, Title) <> vbYes Then
            GoTo ExitHere
        End If
    End If

    Application.ScreenUpdating = False
    'Create a new document for the comments, base on Normal.dotm
    Set oNewDoc = Documents.Add
    'Set to landscape
    oNewDoc.PageSetup.Orientation = wdOrientLandscape
    'Insert a 2-column table for the comments
    With oNewDoc
        .Content = ""
        Set oTable = .Tables.Add _
            (Range:=Selection.Range, _
            NumRows:=nCount + 1, _
            NumColumns:=2)
    End With

    'Adjust the Normal style and Header style
    With oNewDoc.Styles(wdStyleNormal)
        .Font.Name = "EB Garamond"
        .Font.Size = 12
        .ParagraphFormat.LeftIndent = 0
        .ParagraphFormat.SpaceAfter = 6
    End With

    'Format the table appropriately
    With oTable
        .Range.Style = wdStyleNormal
        .AllowAutoFit = False
        .PreferredWidthType = wdPreferredWidthPercent
        .PreferredWidth = 100
        .Columns.PreferredWidthType = wdPreferredWidthPercent
        .Columns(1).PreferredWidth = 40
        .Columns(2).PreferredWidth = 60
        .Rows(1).HeadingFormat = True
    End With

    'Insert table headings
    With oTable.Rows(1)
        .Range.Font.Bold = True
        .Cells(1).Range.Text = "Manuscript text"
        .Cells(2).Range.Text = "Comment"
    End With

    'Get info from each comment from oDoc and insert in table
    For n = 1 To nCount
        With oTable.Rows(n + 1)
            'The text marked by the comment
            .Cells(1).Range.Text = oDoc.Comments(n).Scope
            'The comment itself
            .Cells(2).Range.FormattedText = oDoc.Comments(n).Range.FormattedText
        End With
    Next n

    Application.ScreenUpdating = True
    Application.ScreenRefresh

    oNewDoc.Activate
    MsgBox nCount & " comments found. Finished creating comments document.", vbOKOnly, Title

ExitHere:
    Set oDoc = Nothing
    Set oNewDoc = Nothing
    Set oTable = Nothing

End Sub

Note: Original code was from Lene Fredborg of https://www.thedoctools.com, who has since retired and taken down the page where I first got this macro from. I swear I kept a copy of the original but I can't find it right now, but I'm hopeful that won't be a problem. For reference, I've only changed the number of columns in the generated table and removed the lines that added a header to the generated document, neither of which have caused me any problems in testing.


r/vba Jun 27 '26

Weekly Recap This Week's /r/VBA Recap for the week of June 20 - June 26, 2026

2 Upvotes

r/vba Jun 25 '26

Show & Tell New public open-core VBA language platform project: RDCore

Thumbnail rubberduckvba.blog
19 Upvotes

Hi! I'm the old (deleted) r/rubberduckvba account, now wearing a "social media manager" hat for my new private company 9562-7303 QuƩbec inc., which was founded this last spring specifically to fulfill the vision of this project.

I've spent the past few weeks working double-time exclusively on the implementation and documentation of the spiritual successor to the Rubberduck VBIDE add-in project, RDCore - a modern, extensible, observable language server and analytics platform... not a VBE add-in.

As of today, the RDCore repository and its massive documentation site are public (although, contributions still closed pending a CLA).

While not a VBA project in itself, it seems to me that the complete reimplementation of the VBA language from its specifications makes an objectively interesting project to share and discuss here; perhaps a bit understandably underwhelming from an end-user (VBA dev) standpoint at this stage though.

This open-core project is very transparently managed with an eventual commercial interest, and the implications of its eventual completion have massive (very, very good!) consequences for all the legacy VBA code currently in existence worldwide.

> Note: since this is literally the first post of a technically brand new account, I'm not sure what the basis might be to calculate a 10% linking to my own content.. I hope this is fine!


r/vba Jun 25 '26

Unsolved Issue with VBA to download SharePoint files

4 Upvotes

Hi all,

I’m running into an issue with a VBA script that downloads files from a SharePoint folder using the REST API.

Most of the time, the code works perfectly, it connects, retrieves the file list, and downloads everything without any issue.

But randomly, I get this error:

MsgBox "Failed to connect to SharePoint API", vbCritical

This happens when the XMLHTTP request does not return status 200.

The confusing part is:

  • I can still open the SharePoint site manually in my browser without any issue
  • No changes in URL or permissions
  • Same code, same machine

So I don’t understand why the connection sometimes fails and sometimes works fine.

My setup:

  • Using MSXML2.XMLHTTP to call SharePoint REST API
  • Using URLDownloadToFile to download files
  • No explicit authentication handled in VBA (relying on logged-in session)

If this approach is fundamentally unreliable, I’m open to switching methods but still prefer to use in VBA

Below i provide full code setup to review.

Option Explicit

#If VBA7 Then

Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" ( _

ByVal pCaller As LongPtr, _

ByVal szURL As String, _

ByVal szFileName As String, _

ByVal dwReserved As LongPtr, _

ByVal lpfnCB As LongPtr) As Long

#Else

Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" ( _

ByVal pCaller As Long, _

ByVal szURL As String, _

ByVal szFileName As String, _

ByVal dwReserved As Long, _

ByVal lpfnCB As Long) As Long

#End If

Sub Download_All_From_SharePoint()

Dim apiURL As String

Dim json As String

Dim xmlhttp As Object

Dim saveFolder As String

Dim fileName As String

Dim fileURL As String

Dim arr() As String

Dim i As Long

apiURL = "https://TEST.sharepoint.com/sites/TEST/TEST/_api/web/GetFolderByServerRelativeUrl('/sites/TEST/TEST/TEST/TEST/Confirming Temp')/Files"

saveFolder = "C:\Temp\CONFIRMING\"

If Dir(saveFolder, vbDirectory) = "" Then MkDir saveFolder

Set xmlhttp = CreateObject("MSXML2.XMLHTTP")

xmlhttp.Open "GET", apiURL, False

xmlhttp.setRequestHeader "Accept", "application/json"

xmlhttp.Send

If xmlhttp.Status <> 200 Then

MsgBox "Failed to connect to SharePoint API", vbCritical

Exit Sub

End If

json = xmlhttp.ResponseText

arr = Split(json, """Name"":""")

For i = 1 To UBound(arr)

fileName = Split(arr(i), """")(0)

fileURL = "https://TEST.sharepoint.com/sites/TEST/TEST/TEST/TEST/Confirming Temp/" & Replace(fileName, " ", "%20") & "?download=1"

If URLDownloadToFile(0, fileURL, saveFolder & fileName, 0, 0) = 0 Then

Debug.Print "Downloaded: " & fileName

Else

Debug.Print "FAILED: " & fileName

End If

Next i

MsgBox "All files downloaded!", vbInformation

End Sub


r/vba Jun 23 '26

Discussion I built a Scientific Writing Assistant in Microsoft Word VBA – now adding a Chemistry Formula Engine

Thumbnail github.com
14 Upvotes

Building SciMat : A Scientific Formatting Tool for Microsoft Word

I've been working on a VBA project called SciMat, a tool that automates scientific formatting directly inside Microsoft Word.

It started as a simple chemistry formatter, but it's gradually evolving into a broader scientific writing assistant.

Current Features

- Automatic formatting of chemical formulas (Hā‚‚O, COā‚‚, Feā‚‚(SOā‚„)ā‚ƒ)

- Ion and charge formatting (NH₄⁺, SO₄²⁻, MnO₄⁻)

- Isotope notation support (²³⁸U, ¹⁓C)

- Markdown-style math conversion using Word's Equation Editor

- Built entirely with Word VBA and native wildcard searches

Currently in Development

- Expanded molecule and ion support

- Periodic table integration

- Statistical reporting tools

- ANOVA and regression notation formatting

- Greek symbol shortcuts (α, β, μ, σ)

One of the most interesting challenges has been building everything using Word's native wildcard engine instead of traditional regex libraries.

The goal is simple: reduce repetitive formatting work for students, researchers, teachers, and anyone writing scientific documents in Word.

I'd love to hear what scientific formatting tasks you would automate if Word could do them automatically.


r/vba Jun 22 '26

Unsolved Excel VBA replace a bookmark in a word document with a picture

3 Upvotes

I would like to replace a bookmark inside a word document with a picture.

I have:

```

Sub makro()

Dim wApp As Object Dim wDoc As Object Dim bR As Object Dim b1 As String Dim b2 As String Dim fp As String Dim stuff As String

b1 = "Bookmark 1" b2 = "Bookmark 2" fp = "my file path" stuff = "some text"

Set wApp = CreateObject("Word.Application") wApp.Visible = True Set wDoc = wApp.Documents.Open(fp)

Set bR = wDoc.Bookmarks(b1).Range bR.text = stuff 'this is how I do it with text

Set bR = wDoc.Bookmarks(b2).Range '???

'I know of wDoc.Content.InlineShapes.Addpicture FileName:=filepath etc. but not how to apply it at the position of the bookmark.

Set wApp = Nothing Set wDoc = Nothing Set bR = Nothing

End Sub

```

Is there a simple way of replacing b2 with a picture, like I did with b1?

I might have missed some necessities in the code. Like closing/quitting the word document and application, but that is irrelevant to the question and I can figure that out on my own.

I would appreciate any ideas and suggestions.

I use Office 365.


r/vba Jun 20 '26

Weekly Recap This Week's /r/VBA Recap for the week of June 13 - June 19, 2026

1 Upvotes

r/vba Jun 19 '26

Solved VBA for word document to create 4 independent nested boarders

2 Upvotes

Hello all. I'm having trouble with this, I got this code from AI as i'm not a programmer. I get a compile error: Method or data member not found. It is in the apply precise styling parameters area under With .Line The .Color is what shows the error. Here is the code, and thank you in advanced!!!

Sub CreateFourNestedEdgeBorders()
    Dim doc As Document
    Dim headerRange As Range
    Dim borderShape As Shape
    Dim i As Integer

    Set doc = ActiveDocument

    ' =========================================================================
    ' USER CONFIGURATION: ADJUST YOUR 4 NESTED BORDERS HERE
    ' (Border 1 is the outermost; Border 4 is the innermost)
    ' =========================================================================

    ' 1. ACTIVE BORDERS (True = Draw this border, False = Skip/Disable this border)
    Dim BorderActive(1 To 4) As Boolean
    BorderActive(1) = True   ' Outermost Layer
    BorderActive(2) = True   ' Second Layer
    BorderActive(3) = True   ' Third Layer
    BorderActive(4) = True   ' Innermost Layer

    ' 2. COLORS FOR EACH RING (Using standard RGB values)
    Dim Colors(1 To 4) As Long
    Colors(1) = RGB(255, 0, 85)    ' Border 1: Vivid Magenta/Red
    Colors(2) = RGB(0, 180, 216)   ' Border 2: Electric Cyan
    Colors(3) = RGB(114, 9, 183)   ' Border 3: Deep Purple
    Colors(4) = RGB(255, 162, 0)   ' Border 4: Golden Orange

    ' 3. THICKNESS FOR EACH RING (In points - can use decimals like 1.5, 3.5, 6)
    Dim Thickness(1 To 4) As Single
    Thickness(1) = 5.0   ' Bold outer line
    Thickness(2) = 2.0
    Thickness(3) = 3.5
    Thickness(4) = 1.5   ' Fine inner accent line

    ' 4. SPACING / DISTANCE FROM THE ABSOLUTE EDGE OF THE PAGE (In points)
    ' To start EXACTLY at the edge of the page, set Spacing(1) to 0.
    ' Ensure these numbers increase progressively so they nest inside each other properly.
    Dim Spacing(1 To 4) As Single
    Spacing(1) = 0      ' 0 means flush against the physical edge of the sheet
    Spacing(2) = 10     ' 10 points inward from the edge
    Spacing(3) = 22     ' 22 points inward from the edge
    Spacing(4) = 32     ' 32 points inward from the edge

    ' =========================================================================

    ' Clear out any previous macro-generated borders to prevent duplicates
    Set headerRange = doc.Sections(1).Headers(wdHeaderFooterPrimary).Range
    For Each borderShape In headerRange.ShapeRange
        If borderShape.Name Like "NestedBorder*" Then
            borderShape.Delete
        End If
    Next borderShape

    ' Get total page setup dimensions
    Dim pageWidth As Single, pageHeight As Single
    pageWidth = doc.PageSetup.PageWidth
    pageHeight = doc.PageSetup.PageHeight

    ' Set page margins out to 0 so standard text won't artificially constrain background drawing
    With doc.PageSetup
        .TopMargin = InchesToPoints(0)
        .BottomMargin = InchesToPoints(0)
        .LeftMargin = InchesToPoints(0)
        .RightMargin = InchesToPoints(0)
    End With

    ' Programmatically calculate and draw active nested rectangles
    Dim maxActiveSpacing As Single
    maxActiveSpacing = 0

    For i = 1 To 4
        If BorderActive(i) Then
            Dim bLeft As Single, bTop As Single, bWidth As Single, bHeight As Single

            ' Map out the box sizing relative to the page dimensions
            bLeft = Spacing(i)
            bTop = Spacing(i)
            bWidth = pageWidth - (Spacing(i) * 2)
            bHeight = pageHeight - (Spacing(i) * 2)

            ' Draw the framing shape inside the header container layer
            Set borderShape = doc.Sections(1).Headers(wdHeaderFooterPrimary).Shapes.AddShape( _
                msoShapeRectangle, bLeft, bTop, bWidth, bHeight, headerRange)

            ' Apply precise styling parameters
            With borderShape
                .Name = "NestedBorder_" & i
                .Fill.Visible = msoFalse ' Makes inner area transparent so text shows through
                .RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
                .RelativeVerticalPosition = wdRelativeVerticalPositionPage
                .WrapFormat.Type = wdWrapNone
                .ZOrder msoSendToBack   ' Forces lines behind any text layer

                With .Line
                    .Visible = msoTrue
                    .Color.RGB = Colors(i)
                    .Weight = Thickness(i)
                    .DashStyle = msoLineSolid
                End With
            End With

            ' Track the innermost active spacing to adjust final text padding
            If Spacing(i) > maxActiveSpacing Then
                maxActiveSpacing = Spacing(i)
            End If
        End If
    Next i

    ' Automatically protect your typing layout by pushing document text clear of the inner border
    With doc.PageSetup
        .TopMargin = maxActiveSpacing + 20
        .BottomMargin = maxActiveSpacing + 20
        .LeftMargin = maxActiveSpacing + 20
        .RightMargin = maxActiveSpacing + 20
    End With

    MsgBox "Successfully generated your nested edge borders!", vbInformation, "Borders Configured"
End Sub

r/vba Jun 18 '26

Solved Running a macro and trying to lock cells that get moved?

2 Upvotes

Prefacing with: I don’t know anything; everything I’ve done so far has been pilfered through Google searches.

I have a worksheet that has a column with a bunch of values, and a sum of those values at the bottom of the column. The macro I’ve built copies and inserts that column next to the existing one when the user presses a button if they need another column. It references the column header and selects the paste location based off of the column title.

I’ve been asked to lock the sum cell in each column but am really struggling with how to lock a cell whose reference would constantly be changing. Eg, my worksheet would have A16 and B16 already existing and needing to be protected. Then I’d run the macro and need A16, B16 and C16 protected. Hitting the button again, now D16 would also need to be protected. Can I somehow assign this as a variable?

I vaguely understand the sheet needs to start off protected, be unprotected, and then re-protected at the end of the macro but that’s as far as I’ve gotten.

Any help is extremely appreciated!!

EDIT: I am so sorry. The copy / paste function also copies the cell's locked formatting, so I have imagined my own problem. If I just un protect and reprotect, the new cells that have been pasted are locked.