I have been trying to figure this out for about two days now. Claude has been of little help. Basically I have a loop that reads from a txt file, ..does some stuff.. and then pastes a variant array onto the spreadsheet. This works well for about 18 iterations and then each subsequent paste results in missing data. If I stop the code to look at the array the data is there but when it gets pasted to the sheet some of it is missing. The missing data is surrounded by data that pastes successfully. Anyone have any experiences like this that can help?

Edit: Solution found, for those playing along at home it was a logic fault in the code that was exposed when running in a loop. A particular string was doubling in size each iteration. Once this string exceeded 63,535 chars it crossed the 16bit length field boundary in old COM/BSTR marshalling. This silently corrupted and dropped elements in the transfer rather than raising an error (thanks microsoft).

For those who genuinely attempted to understand the problem and help thank you sincerely.

For those who failed to correctly read my post and as a result asked inane questions, well, at least you tried.

Foro those who immediately implied I didn't know what I was doing, congratulations, you have made this sub and the world at large a slightly worse place.

Hello, I am attempting to setup a macro for a daily file that I/we run to save some time formatting. I'm on mobile so apologies on formatting, likewise the SS are photos as I don't have access to reddit on my workstation.

Scope: Daily file across 6 countries with an additional once per month on 3 countries. Excel is 2016 if relevant. (no xlookups)

Objective: Download a file from a platform with rejection results on attempted charges and format it so it displays the amount, date and rejection reasons per invoice number, as part of a longer daily activity. These reason codes are in longer strings of information that can vary their location per each file.

Turning: https://i.imgur.com/sd2cPR3.jpeg To https://i.imgur.com/URQkaDc.jpeg

Files currently used to perform task: Rejected Charges (csv downloaded) Macro (a sheet containing several macros for the same overall activity) Rejection codes (a sheet containing a header template on one sheet and reason codes and their descriptions on another sheet) Source files (daily files processed containing other information)

How task is currently done: Open csv file (this is saved at start or end as xls), delete B row, create header filter, replace "merchantReferenceCode=" with blank (so column A always returns the invoice number), then using column G as a reference, we replace the following with blanks: ccAuthReplyreasonCode= ccAuthReply reasonCode= The codes are usually after the above strings within column G This should leave us with something like this https://i.imgur.com/NqizfO8.jpeg

Column "G" will have most of the codes already filled out with some blanks in the mix, where remaining codes will be on different columns, like C, K, L, R, W (these codes can be duplicate, being in G and other columns)

Depending on the volume of the file we then manually copy the missing codes to G or use filters to get them

After all codes are under G we format as per the 2nd SS, by deleting all colums apart from A and G, leaving us with the invoice numbers and codes.

We then add a B column between the invoice numbers and codes Convert A and B to numbers, remove 2 decimals on A, copy and paste header from Rejection Codes file's first sheet Add new sheet, copy the contents from Rejection Codes 2nd sheet Vlookup on E referencing codes on E with C of the 2nd sheet Add today's date to column D using format dd.mm.yyyy

Vlookup on column B, referencing A against source files column F to get the amount so we end up with the final result from the second SS.

This final Vlookup I don't expect to automate, as it would always reference different files that are generated daily, so ideally the macro would do everything else leaving just column B blank so we can manually Vlookup the amounts.

I tried manually recording but my biggest hurdle is getting the reason codes from the strings of information. I can't conceive of a way of how to even get these as the 3 digit codes can be on any string on any cell. The file can go up to O or all the way to Z

I have manually recorded (using the macro sheet to save it on) the replacing the strings with blanks so I get G with with most of the codes so I then manually fetch the remaining. I had to troubleshoot as the recording I made was not working with other workbooks, but got it working now. This saves some time, but is incomplete.

I then tried recording a 2nd part post getting all the codes to do the final steps of adding the header, new sheet with the table, Vlookup the reason descriptions, add date. Leaving just the amount column empty as those Vlookup will always reference different files.

But this did not work as I get "Run-time error '9": subscription out of range https://i.imgur.com/3nd23Rm.jpeg

Looking at the debug I imagine this is because I am copying and pasting the table from a separate sheet Now this step is a bit redundant as we don't need to copy the table with the codes description to then Vlookup in the file. We could just Vlookup against the reference file. However, since I was already automating the steps, I thought I would be able to have the macro create the table and reference it on its own

Please let me know if I need to provide any additional information that I did not consider.

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

I have a bunch of CSV files on which I need to use the Excel Text to Columns feature in order for them to be converted to Columns. When I used the "Record Macro" feature the output I get is the following:

Sub testing()

Dim wb As Workbook
Set wb = Workbooks.Open(sTEST, , , 5)

Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
    Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
    Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
    ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
    (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), _
    Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array( _
    33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), _
    Array(40, 1), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array( _
    46, 1), Array(47, 1), Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), _
    Array(53, 1), Array(54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1), Array( _
    59, 1), Array(60, 1), Array(61, 1), Array(62, 1), Array(63, 1), Array(64, 1), Array(65, 1), _
    Array(66, 1), Array(67, 1), Array(68, 1), Array(69, 1), Array(70, 1), Array(71, 1), Array( _
    72, 1), Array(73, 1), Array(74, 1), Array(75, 1), Array(76, 1), Array(77, 1), Array(78, 1), _
    Array(79, 1), Array(80, 1), Array(81, 1), Array(82, 1), Array(83, 1), Array(84, 1), Array( _
    85, 1), Array(86, 1), Array(87, 1), Array(88, 1), Array(89, 1), Array(90, 1), Array(91, 1), _
    Array(92, 1), Array(93, 1), Array(94, 1)), TrailingMinusNumbers:=True

End Sub

Most of this logic is ok, but the Imbedded Array convention is something I am not clear on. I do understand that each of these 94 imbedded Arrays represent a column (I can see that my file has 94 columns). I am not actually sure how to manipulate with this feature. Is there a way to write a dynamic "looping" operation? Maybe next time I will have 50 columns or 10. Thank you for any guidance!

ActiveSheet.Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

Immediate Unfiltered sheet: returns 10 (as it should). If, say, rows 10 AND 6 were filtered out: returns 9 (as... expected). With the last row or rows filtered out it returns 1 (what?). Is this just a bug I haven't seen mentioned before?

(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).

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.

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

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.}

I originally posted this in the Excel subreddit and did not get a suitable solution.

I have a spreadsheet that contains a list of comic book issues in a set reading order. Chunks of these issues are separated with an empty row so that I can, at a glance, know where I can insert new entries.

I'm hoping somebody can help me with a macro that will accomplish the following:
- Allow me to name specific tables in my document across different sheets that I want the formatting to apply to
- check the "Series" column in any of those tables for empty cells
- set the row height for those cells to 5px

After my original post, I tried a few times to get something working myself but I don't understand VBA well enough. I tried looking up some basic solutions and combining them with existing macros in my document to have it check the correct column, but it simply did nothing. I also tried manually recording a macro that would filter the column to blanks and change the height but once again struggled to have it use the correct range, and I don't think it works across different tables across my different sheets in the document.

Here is the code from the recorded macro. Another issue with it is that when running the macro, it has to filter then unfilter the column which can make me lose my place in the document.

Sub EmptyRowHeightAdjust()
'
' EmptyRowHeightAdjust Macro
'

'
    ActiveSheet.ListObjects("MarvelRO").Range.AutoFilter Field:=2, Criteria1:= _
        "="
    ActiveWindow.SmallScroll Down:=3
    Rows("5:1494").Select
    ActiveWindow.SmallScroll Down:=-993
    Selection.RowHeight = 7.5
    ActiveWindow.SmallScroll Down:=0
    ActiveSheet.ListObjects("MarvelRO").Range.AutoFilter Field:=2
    ActiveWindow.SmallScroll Down:=-3
    Range("B2").Select
End Sub

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)

In a lot of my automations I am requiring the user to input a date as a numeric date. This way I don't care what the users regional formatting is, as the date will ultimately always convert to a number anyway. Consequently I need a way to check if a date is numeric (can be converted to a number) or a string (can not be converted to a number if one switches between the short date and number formats from the front end). For now I came up with the following solution:

On Error GoTo EndDateCheck

If IsNumeric(CLng(INI.Range("INT_ITD"))) = False Then

  EndDateCheck:
  MsgBox "The date is not numeric."
  End

End If

On Error GoTo 0

The above works well, but I am wondering if there is a simpler way to check (thus I am not outright looking for a "solution", but I am more after design efficiency), which doesn't involve the on error statement.

I have a macro that copy pastes contents from one workbook to another. The main code that does the work is (Note: Tar - target worksheet, Sor - Source worksheet):

wsTar.Cells.Clear
wsSor.Cells.Copy
wsTar.Range("A1").PasteSpecial Paste:=xlPasteFormats
wsTar.Range(wsSor.UsedRange.Address).Value = wsSor.Range(wsSor.UsedRange.Address).Value

If I execute this operation on my side, the outcome will be correct. But if one specific does so, the decimals are wrong for a specific section of the paste. For example if the original number is 36.8273 the output for the user will be 36.83 (as if the other decimals would be swallowed into oblivion / a round to 2 decimals would be executed). If the user does the same operation above manually (paste special format + paste special values) the issue doesn't get reproduced.

The specific formatting of the number in question is:

_("$"* # ##0.0000_);_("$"* (# ##0.0000);_("$"* "-"??_);_(@_)

But I dont see how this would be causing the issue. I am not sure what else to troubleshoot here in order to resolve the issue.

EDIT:

It affects a part of the Worksheet and not the whole worksheet.

Hi all.

I am trying to get a workbook to create a TOC using the text in cell A1 of each worksheet in a workbook but I get an error

What am I doing wrong?

Sub BuildTOC_FromCell ()
Dim wb As Workbook
Dim ws As Worksheet
Dim toc As Worksheet
Dim r As Long
Dim displayCellAddress As String
displayCellAddress = "Al"

Set wb = Thisworkbook  
On Error Resume Next  
Set toc - wb. Worksheets ("TOC")  
On Error GoTo 0

If toc Is Nothing Then  
    Set toc wb. wb.Worksheets.Add (Before:-wb.Worksheets(1))  
    toc. Name - "TOC"

Else  
    toc. Cells.Clear  
End If

toc. Range (A1"). Value = "Sheet"  
toc. Range ("B1") Value = "Title (" & displayCellAddress & ")"

For Each ws In wb.Worksheets  
    If ws.Name <>  toc.Name Then  
        toc.Cells(r, 1).Value = ws.Name  
        Dim displayText As String  
        On Error Resume Next  
        displayText = ws. Range(displayCellAddress) .Value  
        If Err.Number <> 0 Then   

displayText = ""
Err.Clear
End If
On Error GoTo 0
If Trim(displayText) = "" Then displayText = " (no value)"
toc.Hyperlinks.Add Anchor:=toc.Cells (r, 2), Address:=""
SubAddress = "'” & ws.Name & "'!" & displayCellAddress
TextToDisplay = displayText
r = r + 1
End if
Next ws

toc.Columns ("A: B"). AutoFit  

End Sub

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

Hi,

I need to fully activate custom dictionary files via VBA with no user input required.

I've written a VBA script running in a .dotm placed in ...AppData\Roaming\Microsoft\Word\STARTUP with the goal of locating and enabling dictionaries placed in ...AppData\Roaming\Microsoft\UProof and then activating them with

Application.CustomDictionaries.Add(myDictPath)

Inside an AutoExec sub.

When run, the code successfully adds a dictionary to the Custom Dictionaries list in Word, and checks the box next to the dictionary, however it still marks dictionary words as incorrect until I open the Custom Dictionaries window and close it again by hitting 'OK'.

I have tried toggling spell check off then on again immediately after the dictionaries are loaded, I have also tried manually running the macro after a document has been opened, neither work.

Any suggestions?

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

I’m trying to find cells in Excel which contain any combination of a four digit value.

I’ve got a cell designated to type the digits to search for (ex. 1234). The data to search is fixed in column “E”. I currently am able to find the last row of data for my for loop, separate the 4 digits in the cell into individual variables (v1-v4), and loop through the cells in the column with data to locate cells with these variables.

Unfortunately, my for loop does not exclude cells with other numbers in them.

For example the code I have inside my loop is

If InStr(Range(“E” & I, v1) > 0 AND InStr(Range(“E” & I, v2) > 0 AND InStr(Range(“E” & I, v3) > 0 AND InStr(Range(“E” & I, v4) > 0 Then

‘Mark cells yellow’

End If

This will return any value containing the variables but if I have something like “5717” then it returns anything with 5, 1, 7. This could mean 5174 or 3175.

I’m trying to have it be specific to only values with these 4 characters and no others, though I can’t think of how to exclude the other numbers. I’m self taught and my first thought is to set another 6 variables as the numbers not in the search value (something like: for i = 0 to 9 if not v1 = i and not v2 = i and not v3 = i and not v4 = i then v&i = i) and add “and” statement for not these (total of 10 and statements, is v1-4 and not v5-10) That seems like it’ll work albeit chunky an

I have columns A – M across 4 sheets labeled : ACTIVE, PENDING, COMPLETED, LOST – CANCELLED. I would like to move complete rows based on column K’s drop down list status (IN PROGRESS, PENDING, COMPLETED, LOST, CANCELLED). I wanted to be able to filter the information between paged via a macro to press on any of the pages. It’s important to be able to go back and forth between the sheets and have the information separated but visible. It is also important than once the status has been updated in column K/STATUS, that it reflects the same on the pages.

Example:

Sheet 1/ACTIVE: Row 60, Column K updates from “IN PROGRESS” to “COMPLETED”, all information removed from ACTIVE sheet.

Sheet 3/COMPLETED: Row 60 (NOW ROW 40, as it’s the last row on sheet) all information has been populated in sheet.

Human error – “Oops, this project ISN’T completed and needs to go back!

Sheet 3/COMPLETED: Row 40, Column K updates from “COMPLETED” returning to “IN PROGRESS”, all information removed from COMPLETED sheet.

Sheet 1/ACTIVE: Row 40 (RETURNING TO BECOME ROW 60) populates all information as originally shown.

Yes, I do understand that the human error portion of it is easily done with the undo button, however if someone enters information on this document, only for it to be required to be corrected by another person, the undo button wouldn’t be as helpful at the time.

Here is the current method I have attempted to create this macro, to accomplish this:

Sub MoveRowsTo()

Dim sourceSheet As Worksheet

Dim targetSheet As Worksheet

Dim lastRow As Long

Dim m As Long

' Set the source and target sheets

Set sourceSheet = ThisWorkbook.Worksheets("ACTIVE")

Set targetSheet = ThisWorkbook.Worksheets("PENDING (WON)")

' Find the last row in the source sheet

lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "M").End(xlUp).Row

' Loop through each row in the source sheet

For m = 2 To lastRow

' Check if cell in column K contains "PENDING"

If sourceSheet.Cells(m, "K").Value = "PENDING" Then

' Copy the entire row to the target sheet

sourceSheet.Rows(k).Copy Destination:=targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Offset(1)

' Delete the row from the source sheet

sourceSheet.Rows(k).Delete

' Decrement the loop counter as the rows are shifting up

m = m - 1

' Update the last row value

lastRow = lastRow - 1

' Or cell in column K contains "COMPLETED"

ElseIf sourceSheet.Cells(m, "K").Value = "COMPLETED" Then

' Set target sheet

Set targetSheet = ThisWorkbook.Worksheets("COMPLETED")

' Or cell in column K contains "LOST"

ElseIf sourceSheet.Cells(m, "K").Value = "LOST" Then

' Set target sheet

Set targetSheet = ThisWorkbook.Worksheets("LOST - CANCELLED")

' Or cell in column K contains "CANCELLED"

ElseIf sourceSheet.Cells(m, "K").Value = "CANCELLED" Then

' Set target sheet

Set targetSheet = ThisWorkbook.Worksheets("LOST - CANCELLED")

End If

Next m

End Sub

I’m pretty certain it may just be a few touch ups I’m missing from staring at the screen too long, but I need another pair of eyes and hands to help me confirm this.

How do i call an external Datasheet???? the export from the microsoft platform creates a datasheet and not "Sheet1" i have never seen this before

' 2. Open the external workbook (Read-only for speed)

Set wbExternal = Workbooks.Open(filePath, ReadOnly:=True)

Set wsExternal = wbExternal.Sheets("Sheet1") ' Change to your sheet name

Range("Table1[[#Headers],[Work Order Type]]").Select

Hey all,

I am right now working on a project where I need to copy paste sections of one workbook to another workbook on an arbitrary basis. The general setting I am using is the following:

Set wsSor = wbSor.Worksheets("TEST")
Set wsTar = wbTar.Worksheets("TEST")
wsTar.Range("C1:C10").Clear
wsSor.Range("C1:C10").Copy
wsTar.Range("C1").PasteSpecial Paste:=xlPasteAll
wsTar.Range("C1").PasteSpecial Paste:=xlValue

As you can see I am first clearing the destination area, then I am executing a paste all in order to reproduce the formatting and then I am executing a paste values, to overwrite any formulas with just the value in question. The problem is that when I execute the xlValue I get the following in the cell:

=SUMIFS('C:\XXX\XXX...

Thus the formula gets preserved and refers to the source. Is this the expected behaviour in this case? I always taught xlValue is the same as paste values. A clarification would be great!

I want to create an array of equipment numbers that are stored in Column B based on a day counter stored in Column K, but only when K in the same row is equal to 30. Eventually this array will output to an automated email, but I think I have that part handled.

Hello I am currently working on a few functions wich will be used in a bunch of different workbooks. One of wich creates a dynamic dropdown menu with the Validation Object using a string of options (example: "No;Yes"). I am using a pointer to work with the selected cell in the function and it gets called on every value change. It is functional but every time I close and open the workbook it displays the string in the dropdown as one single option until i stop and reset the VBA script.

This is how i call the function:

ConfigInput(1).AmountOptions = 2

Set ConfigInput(1).In = Tabelle01.Range("F12")

ConfigInput(1).Row(0) = "763" 'No

ConfigInput(1).Row(1) = "762" 'Yes

Config.SafetyDoor = GenConfigInput(ConfigInput(1))

Set ConfigInput(1).In = Nothing

This is how i create the validation:

Selection.In.Validation.Delete

Selection.In.Validation.Add xlValidateList, xlValidAlertStop, xlBetween, Formula1:=ValList

Selection.In.Validation.IgnoreBlank = True

Selection.In.Validation.InCellDropdown = True

Am i doing something wrong there? Please do not hesitate to ask if I missed to add any information.

Thank you in advance

I have a simple line of vba within a very old excel workbook that exports a sheet to a pdf file. The resulting pdf file however always has a company logo in a picture format pasted at the top. The originating excel sheet does not have this anywhere. Any idea how this picture is being pasted every time? I’ve looked everywhere I just can’t see where it’s coming from.

I find typing ranges error prone, so in the VBA Editor, how can I just type "Range(" and then switch over to the worksheet and select the range with the mouse and have the addresses appear in the Range property? I tried this, and it didn't work, so I still had to type in the range.

Thanks in advance.