Does anyone know if it possible to use Control Char inputs on an Excel VBA userform.

By that I mean for example, while entering text in a TextBox, CombiBox etc, to be able to use ^L to convert the currently entered text to Lowercase. I use many such macros all the time in excel spreadsheets for Uppercase, Lowercase, Titlecase, Propercase, Trim etc, and it would obviously be best if I could access existing macros but not much effort to add code to a userform if necessary.

Actually, in writing this I've just had a brainwave... to use the Userform:TextBox_Change routine to check for the control characters - then delete from string and perform the required Upper/Lowercase etc - but it seems that the control characters don't get passed through to the subroutine, so this doesn't work

Private Sub Textbox1.change()
    If InStr(Textbox1.Text,Chr(12)) then ' ^L entered
        Textbox1.text=LCase(Replace(Textbox1.text,Chr(12),"")) ' remove ^L and cvt to lowercase
    End If
End Sub

Any suggestions?

Thanks.

I have set up an inventory management system in excel.

It is fully functional. I have some doubts, if anybody who is an expert in vba, please help me to clear the doubts.

I have total 7 sheets dashboard, purchase, sales, inventory, enternewproduct, purchase entry, sales entry.

How long does the vba code works efficiently?

Does the excel file crash or go corrupt because of vba code?

How many rows of data excel can handle smoothly with vba code? I have 3 sheets inventory, purchase and sales that will hold all the data.

All of these doubts might sound stupid but I wrote 99% of the code with the help of chatgpt so have no idea about VBA.

Edit: here is the excel file download

All the doubts I have are related to VBA code since i have no idea how powerful VBA code could be.

Hi I'm making a macro and need to input data from a user form in the next available cell. I have tried this:

Range("A4").end(xlDown).offset(1,0).value = txtdate.value

I saw this on a VBA tutorial on youtube

But this gives runtime error 1004.

Anyone who can help explain why this wont work and knows another way?

Thanks!

I am brand new to VBA and macros as of today. Long story short, I'm trying to code a macro that will let me save 30+ sheets in a single workbook as individual PDFs, each with a specific name. Name is defined by cell AU1 in each sheet.

Here is what I've been able to scrape together so far:

Sub SaveIndividual()

Dim saveLocation As String
Dim Fname As String
saveLocation = "C:\Users\[my name]\Desktop\[folder]\SAVETEST\"
Fname = Range("AU1")

For Each ws In ActiveWorkbook.Worksheets
Application.ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
  FileName:=saveLocation & Fname & ".pdf"
Next ws

End Sub

When I try to run it, I get an "application-defined or object-defined error" pointing to

Application.ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
  FileName:=saveLocation & Fname & ".pdf"

I have visited the help page for this error and have not really been able to figure out what it means in regards to my particular project - mostly because I'm not too familiar with coding language generally and I'm also at a point in my day where even somewhat dense text is not computing well. I tried swapping out Fname in the bolded section for just "test" (to see if that variable was causing it) and got the same error. I also tried saving as a different file type (both excel file and html) and got an "Invalid procedure call or argument (Error 5)"

What am I missing here?

P.S. If there's anything else I'm missing in the code as a whole here please let me know, but please also explain what any code you are suggesting actually does - trying to learn and understand as well as make a functional tool :)

I'm new to VBA and used chatgpt to make this Macro. however this line is giving me issues.

" If ws.Name outputSheet.Name Then ' Exclude the output sheet (CORRECTED)"

Does anyone know what's going wrong? Below is the whole code.

The goal of the macro is to do this: Pull a list of unique values from cell ranges B9:C43 from the tabs listed in the sheet named "Tab Names" which has a table named ProjTabNamesTbl in column A.

Sub GetUniqueValuesFromMultipleSheets()

Dim dict As Object

Dim outputSheet As Worksheet

Dim outputRow As Long

Dim sheetName As String

Dim ws As Worksheet

Dim cell As Range

Dim key As Variant

Dim projTabNamesTbl As ListObject

Set dict = CreateObject("Scripting.Dictionary")

Set outputSheet = ThisWorkbook.Sheets("Emp") ' Change "Summary" to your output sheet name

outputRow = 2 ' Start output from row 2

' Get the table with sheet names

On Error Resume Next

Set projTabNamesTbl = ThisWorkbook.Worksheets("Tab Names").ListObjects("ProjTabNamesTbl")

On Error GoTo 0

If projTabNamesTbl Is Nothing Then

MsgBox "Table 'ProjTabNamesTbl' not found on sheet 'Tab Names'.", vbCritical

Exit Sub

End If

' Loop through each sheet name in the table

For Each cell In projTabNamesTbl.DataBodyRange.Columns(1).Cells

sheetName = cell.Value

' Check if the sheet exists

On Error Resume Next

Set ws = ThisWorkbook.Worksheets(sheetName)

On Error GoTo 0

If Not ws Is Nothing Then

If ws.Name outputSheet.Name Then ' Exclude the output sheet (CORRECTED)

' Loop through the range B9:C43 on the current sheet

For Each cell In ws.Range("B9:C43")

If Not IsEmpty(cell) Then

dict(cell.Value) = 1 ' Add the value to the dictionary

End If

Next cell

End If

Else

Debug.Print "Sheet not found: " & sheetName

End If

Set ws = Nothing ' Release the worksheet object

Next cell

' Output the unique values to the summary sheet

For Each key In dict.Keys

outputSheet.Cells(outputRow, 1).Value = key

outputRow = outputRow + 1

Next key

End Sub

I've got a workbook that does a significant amount of changes to multiple files every night and just starting the last couple of weeks it has started failing for really odd reasons like not being able to set horizontalalignment, in a macro that has done just that for years without problem. When it gets the error, even when VBA is paused, there is a blue spinning wheel cursor flickering with the mouse cursor and while I can select and change data within cells, it doesn't show the selection around the cell. Is anyone having recent errors pop-up? It is reminiscent of last year when files were getting corrupted from an excel update and random errors would manifest.

Hello,

I obtained a promotion and am now kind of an analyst for my company, long story short, this company didn't really made a good transition regarding exploiting data and we (3ppl in my team but only me and my n+1 produce new files and know how to VBA) must manipulate data through almost only excel, analyse the result and present it to the board / clients.

We are talking here of old workbooks weighting >50Mo, >500 000 lines per sheet, fulls of formulas, daily production results of hundreds of employees, sources files coming from multiples other workbooks (of the same kind) and all this, must of course be, organise in a way that not only "tech people" can use it but other kind of employees (managers for example, to follow the stats of their team).

Since 6 months I am on that a good chunk of work has been done but with the ever expanding demands from everyone in the company, the size of excel workbooks and the "prehistoric working computer" gives me headaches to produce something correct as I often got the famous "excel missing memory"

I know there are discussions to change all employees computers and change our data management, but this isn't for tomorrow :(

Yes I tried all the common methods you can find by googling and no for some files it is almost impossible to make it smaller (because that would imply to have multiple workbooks open for the formula to works.. And yes I tried with formulas that works in closed workbooks and the result is worse...).

Just wondering, how do you deal with this kind of issues ?

Is VBA more efficient to manipulate this kind of data (has mentioned earlier, few ppl in my company could maintained/upgrade in VBA, so I'm mindful and try to not use it in order to let the workbooks scalable) ?

Should I just scrap the whole thing and produce it through VBA ?

Hello all, first time posting here. I was hoping to get some advice on how to deal with converting 32-bit code to 64-bit. My experience level is somewhere between beginner and intermediate, and I'm not the creator of these programs (he has since retired from my org). I'm trying to convert these programs and continue to run into various issues, so any advice would be appreciated.

Edit: most common problem there are some Calendar userform issues. Currently working on a solution. Depending on our programs I seem to have 1 of 3 possible solutions.

1. Work w/ IT dept to install a specific add-on, our IT is unreliable so I'm not banking on this.

2. Create custom userform fore date/time picking and incorporate into code. A bit of extra work, but I've found examples to go off of.

3. Some programs I can make the date entry just serve as a txtbox user input, much simpler imo...

If anyone has additional suggestions or cautions I'd appreciate it.

Thanks for all who've answered and thanks in advance for anyone who will add on.

I have an integer array that can have up to 1000 randomly generated values. I want my code to take a single action if any part of the array equals a pre-determined value. What's the best way to code this?

I have to write a macro for an accounts receivable task but my VBA skills are not good enough for me to write correct code on the first try. In other languages with an IDE that’s not a problem, since I can constantly rerun the code after making changes. How could I replicate this with VBA without having to back up 10-20 versions of the original dataset? The overall project is fairly simple. Get data from x and y, if data is in X apply formulas here and there etc etc then merge the tables. I already know I’ll have isssues with number conversions and stuff like that and if I have a step where I add a column, then the next step fails, I don’t want do get a new column once I run it again when I modify what’s wrong

Hey there,

i currently have to design a 100*100 pixel "screen" in VBA, which should detect a mouseclick and where it was clicked(x, y) and should also be able to change the pixels via a Draw(x, y, Color) call or something similar. I Currently use 10000 dynamically created Textbox controls and use its _Click() Event to get its position (the .Name will return "x_y"). As one might imagine, creating that many Controls is quite heavy for the usual Work-PC.

Im searching for an alternative. The thing is: i cannot use the Windows API´s as my Company doesnt allow that. My question is simple:

Is there a control, that can detect the clicked pixel and change it via code?

I thought of creating Bitmap data and sending it to an Image Control, but for that i have to create a Bitmap FILE (according to Internet, havent tested yet).

I also thought of Listbox or Listview, but they can only change the forecolor and not the backcolor of the Cell.

I have a checks file that brings in data from several other files to perform various checks. Every month, I copy last month's check file, copy it into a new folder, and edit links to the new month.

• Each month's check file will be in the same folder as that month's other files.
• The new month's check file will be in a different folder from last month's.
• The other files will have a name along the lines of "This Report v1.21 - NYC", "This Report v1.21 - Boston", etc.
• The following month, the naming will be the same, except it will be v1.22 or something.
• So, each month's folder will have three types of files: the main file, the city files created from the main file, and the checking file. Each month, I copy the main file and the checking file from the previous month's folder and paste them into this month's folder. I then run vba in the main file to create the city files for the month. I then want to open the checking file and update the links from last month's city files to this month's city files. All current month's files will be open and no prior month's files will be open. The links to be updated are in-cell formulas. The type that are edited by navigating to Data > Edit Links

Could I find last month's links by using "*NYC*" and replace with this month's NYC file? Or something along those lines?

There are 10ish links in the file and none will have a duplicate city name, but they all have the same name up to their city suffix.

In short, I think what I would like to do is replace the "*... - NYC" link with something like ThisWorkbook.Path & "* - NYC"

I've attempted to do something like:

Sub ChangeLink()
     ActiveWorkbook.ChangeLink Name:= _
        "* - NYC*" _
        , NewName:= _
        ThisWorkbook.Path & " - NYC.xlsm" _
        , Type:=xlExcelLinks
End Sub

The above code gives me run-time error '1004': Method 'ChangeLink' of object '_Workbook' failed

Last week I posted a simple proof of concept for how to use your existing VBA language skills to make high-performance XLL addins via twinBASIC, but it wasn't very useful, just showing a messagebox on load. This followup shows how to create User-Defined Functions in XLLs. Additionally, I've added helper functions to the SDK to wrap many of the gory details of handling XLOPER12 types, especially for Strings. XLL UDFs directly execute native compiled code, making them substantially faster than the P-Code interpreter that runs regular Office VBA. Once twinBASIC supports LLVM optimization in the near future, it will go from 'substantially faster' to 'completely blows it out of the water'.

There's a much more detailed writeup in the GitHub repo.

https://github.com/fafalone/TBXLLUDF

I'm hoping to find a way to use Regular Expressions in VBA without referencing that library.

I can't find info online if the native REGEX functions coming out in Excel can be user in VBA, but I'm hoping that is the case in the near future.

I sometimes have hundreds of images in .webp format in a folder and i need them in another format, typically .jpg and doing it manually by uploading to different online converters and redownloading becomes a pain in the ***.

I have looked into using an online API but they tend to either require your credit card information, limit you to a few conversions a day or have tokens that needs to be updated. I have used API's for other things in the past but not something that is supposed to download things.

I have found a solution that needs you to download an .exe file first but this is a problem as the guys in IT safety wont trust the file and I am planning to distribute this converter-tool to others by having it in a shared add-in.

I can manually open the .webp image in MS paint and save it using another format but i am having troubles automating this. I have found examples of people opening things in paint using powershell but i am missing the part where it saves the file using another format. If anyone knows how to do this then that would be an OK solution.

Ideally i would like to be able to do it purely in vba excel but im not sure how to go about doing that.

Any help would be appreciated. Thank you.

Saturday, December 07 - Friday, December 13, 2024

###Top 5 Posts

###Top 5 Comments

Hey folks, this one will no doubt make me look silly.

I want to loop through a files in a folder and get the name of each file. I've done it before so I'm going mad not being able to do it this time. Unfortunately my loop is acting as though there are no files in the folder, when there are, and other parts of the code confirm this.

Here is the code I'm using:

Sub Get_File_Names()

 

Dim fObj As FileSystemObject, fParent As Scripting.Folder, fNew As Scripting.File, strParent As String, rPopTgt As Range

 

Let strParent = ActiveSheet.Cells(5, 9).Value

 

Set rPopTgt = Selection

Set fObj = New FileSystemObject

Set fParent = fObj.GetFolder(strParent)

 

Debug.Print fParent.Files.Count

 

For Each fNew In fParent.Files

 

    rPopTgt.Value = fNew.Name

    rPopTgt.Offset(0, -1).Value = fParent.Name

    Set rPopTgt = rPopTgt.Offset(1, 0)

           

Next fNew

 

End Sub

Things go wrong at For Each fNew In fParent.Files, which just gets skipped over. Yet the Debug.Print correctly reports 2 files in the fParent folder.

I invite you to educate me as to the daftness of my ways here. Please.

Hey there, im trying to set up an Access Database on a Sharepoint to add a new Item to a Table.

I already have a connection in an Excel file, that works with the sharepoint link to refresh. I can add new queries without a problem. Everything works fine. But when trying to Open it in VBA i get the error: Could not find installable ISAM.

The link works, as pressing it will open the file and i use said link to refresh the queries.

I tried synchronizing it to Windows Explorer and using that link. That works perfectly fine and would be my second option, but i have 100s of people who would need to do that and im trying to automate as much as possible for the user.

This piece of Code has the Problem:

    Dim ConnObj As ADODB.Connection
    Dim RecSet As ADODB.Recordset
    Dim ConnCmd As ADODB.Command
    Dim ColNames As ADODB.Fields
    Dim i As Integer
    
    Set ConnObj = New ADODB.Connection
    Set RecSet = New ADODB.Recordset


    With ConnObj
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = Settings.Setting("DataBase Path") '<-- this will get the link from an Excel Cell
        .Open '<-- Error here
    End With

The link used would be this (changed so that i dont expose my company:

https://AAA.sharepoint.com/ZZZ/XXX/YYY/TestServer/DataBase.accdb

I also tried this variation:

https://AAA.sharepoint.com/:u:/r/ZZZ/XXX/YYY/TestServer/DataBase.accdb

I have a rate sheet that consists of more than 100 rows.

When rates change, I have been updating each row manually.

Today, I have entered formulas into most of the rows. Now, I only have to update 7 of the rows manually.

I have changed the colors of these 7 cells so that I can easily find them.

However, is there a macro I can create where a form will pop up and allow me to easily enter the updated values on that form? (and of course, update my database sheet)

Solved. I created a UserForm. I used Meta AI to create the code for the Userform. I gave it the exact names of my textfields and the cells that each textfield needed to update. I gave it the exact name of my command buttons. I also asked it to write the code to include a keyboard shortcut, make it a public code so other users can access it, and make it so that it shows up on the macro list. So, when I got to the Developer tab and hit Macro, my UserForm pops up and I can run it from there.

I also created an alternative workbook to include an inputs sheet that allows me to update the cells from there instead of having to scroll through all of the rows on the main sheet.

I'm having a problem with generating a table with VBA. I'm getting an error '438': Object doesn't support this property or method to the following line: value = swTable.SetCellText(rowindex + 1, 1, prefix). I know that the form is wrong, but I couldn't understand how it should go from the web https://help.solidworks.com/2020/english/api/swdocmgrapi/SolidWorks.Interop.swdocumentmgr~SolidWorks.Interop.swdocumentmgr.ISwDMTable~SetCellText.html. If a clever guru could help a newbie, I would be extremely grateful.

What I'm trying to accomplish that the number of rows always adds up depending how many notes there are on a drawing, the number of column is always 2, and that the first column (for eg if all notes have the form of PMAxx-xxx, x is the number) is PMAxx and the second column is xxx, depending if there are multiple of the same PMAxx, then the numbers after - add up. My whole code is the following:

Dim swApp As Object
 Dim resultDict As Object
 Dim prefix As Variant
 Dim number As Double
 Dim rowindex As Integer
 Dim swModel As SldWorks.ModelDoc2
 Dim swView As SldWorks.View
 Dim swNote As SldWorks.Note
 Dim annotations As Object
 Dim noteText As String
 Dim parts As Variant
 Const MATABLE As String = "C:\Users\xx\Documents\PMA.sldtbt"
 Dim swTable As SldWorks.TableAnnotation
 Dim swDrawing As SldWorks.DrawingDoc
 Dim value As Integer
      
    
    
Sub GenerateSummaryTable()
  
    Set swApp = Application.SldWorks
    Set swDrawing = swApp.ActiveDoc
    Set swModel = swApp.ActiveDoc
    Set swView = swDrawing.GetFirstView

    Set resultDict = CreateObject("Scripting.Dictionary")

    If swDrawing Is Nothing Then
        MsgBox "No drawing open."
        Exit Sub
    End If

    Set swNote = swView.GetFirstNote
    Do While Not swNote Is Nothing
        ' Check if the note text contains "PMA"
        noteText = swNote.GetText
        If InStr(noteText, "PMA") > 0 Then
            ' Extract the prefix and number (e.g., PMA17-100)
            parts = Split(noteText, "-")
            If UBound(parts) > 0 Then
                prefix = Trim(parts(0)) ' e.g., "PMA17"
                number = Val(Trim(parts(1))) ' e.g., 100

                If resultDict.Exists(prefix) Then
                    resultDict(prefix) = resultDict(prefix) + number
                Else
                    resultDict.Add prefix, number
                End If
            End If
        End If
        Set swNote = swNote.GetNext
    Loop

    rowindex = 1
    Set swDrawing = swModel
    
    Set swTable = swDrawing.InsertTableAnnotation2(False, 10, 10, swBOMConfigurationAnchor_TopLeft, MATABLE, resultDict.Count + 1, 2)

    If swTable Is Nothing Then
        MsgBox "Table object is not initialized"
     Exit Sub
    End If

    If resultDict Is Nothing Or resultDict.Count = 0 Then
        MsgBox "The resultDict is empty or not initialized"
        Exit Sub
    End If


    For Each prefix In resultDict.Keys
        value = swTable.SetCellText(rowindex + 1, 1, prefix)
        value = swTable.SetCellText(rowindex + 1, 2, CStr(resultDict(prefix)))
        rowindex = rowindex + 1
    Next prefix

    MsgBox "Table generated successfully."
End Sub

Hi,

Trust you are well.

I am writing a Solidworks VBA script that numbers an assembly BOM (generates ERP integration data). The core process uses a depth recursion (recursion inside for loop). I am using a depth recursion because I want to be able to fallback to parent's properties when doing certain operations inside the recursive loop.

Is there a way to solve this issue via increasing the stack size?

Failing the above, is it recommended to substitute above recursive procedure? The error is expected to be rarely triggered in production compared to the test scenario.

Thanks.

Note: I have checked for unstable solutions within the loop but there arent any (by reducing the number of components at the top level while maintaining same depth of BOM, the recursion exits without throwing an error)

I have 2 workbooks. Workbook named rozliczenia1.08.xlsm And NieAktywniKierowcy.xlsm(can be xlsx if needed) the path is the same user\documents
I will start with wb Rozli… I have a sheet named „Lista Kierowców” where i have a table named „TAbela_kierowcow” where i will need the column K (11th, named „aktywny kierowca”) Where the values are picked from a dd true or false. I want to make a button with a macro that loops true the rows of that table and find in column K, False. IF found i want to copy it and pastę the entire row to the workbook called NieAktywniKierowcy on the first sheet on the first empty row . It can be a table a rangę or even of it is the last option just values I have this codę but it doesnt copy the rows no errors the second workbook opens i see in the immediate Windows that i found the rowswith false and also debug message row added. The fun part starts that if the second workbook is opened and i restart the sub the values are copied but the workbook doesnt close or save… Can someone help ? I can send screenshot later. Sub CopyInactiveDrivers() Dim wsSource As Worksheet Dim wsDestination As Worksheet Dim tblSource As ListObject Dim tblDestination As ListObject Dim sourceRow As ListRow Dim destinationRow As ListRow Dim wbDestination As Workbook Dim wbSource As Workbook Dim destinationPath As String Dim i As Long Dim sourceValue As Variant

	' Disable screen updating, calculation, and events to speed up the process
	Application.screenUpdating = False
	Application.calculation = xlCalculationManual
	Application.enableEvents = False

	On Error GoTo CleanUp

	destinationPath = Environ("USERPROFILE") & "\Documents\ListaKierowcowNieAktywnych.xlsm"

	' Open source workbook (this workbook)
	Set wbSource = ThisWorkbook

	' Open destination workbook without showing it
	Set wbDestination = Workbooks.Open(destinationPath)

	' Set references to the source and destination worksheets
	Set wsSource = wbSource.Sheets("Lista Kierowców") ' Replace with the actual sheet name
	Set wsDestination = wbDestination.Sheets(1)       ' Refers to the first sheet in the destination workbook

	' Set references to tables
	Set tblSource = wsSource.ListObjects("Tabela_Kierowców")
	Set tblDestination = wsDestination.ListObjects("TabelaNieAktywnychKierowcow")

	' Loop through each row in the source table
	For i = 1 To tblSource.ListRows.Count
		Set sourceRow = tblSource.ListRows(i)

		' Check the value in column K (11)
		sourceValue = sourceRow.Range.cells(1, 11).value
		Debug.Print "Row " & i & " - Value in Column K: " & sourceValue  ' Output to Immediate Window

		' If the value is False, copy to destination table
		If sourceValue = False Then
			' Add a new row to the destination table at the end
			Set destinationRow = tblDestination.ListRows.Add

			Debug.Print "New row added to destination"

			' Copy the entire row from source to destination
			destinationRow.Range.value = sourceRow.Range.value
		End If
	Next i

	' Force save and close the destination workbook
	wbDestination.Save
	Debug.Print "Workbook saved successfully"

	' Close the workbook (ensure it's closed)
	wbDestination.Close SaveChanges:=False
	Debug.Print "Workbook closed successfully"

CleanUp:
	' Re-enable events and calculation
	Application.screenUpdating = True
	Application.calculation = xlCalculationAutomatic
	Application.enableEvents = True

	' Check if there was an error
	If Err.Number <> 0 Then
		MsgBox "Error: " & Err.Description, vbCritical
	End If
End Sub

Here is my code below:

If schedule = 0 And XYZ > 0 Then AB = value BC = value Else outputsWs.Cells(bidTableStartRow + i, bidTableStartCol + 4).Value = AB (blank reference) outputsWs.Cells(bidTableStartRow + i, bidTableStartCol + 5).Value = BC (blank reference) End If outputsWs.Cells(bidTableStartRow + i, bidTableStartCol + 4).Value = AB outputsWs.Cells(bidTableStartRow + i, bidTableStartCol + 4).Value = BC

So I want the AB values to either give me the “value” for the specific conditions and then for all other values, leave the cell blank. I used a blank reference cell and for some reason it is not working. I have tried a few ways and chat GPT but the blanks are just not populating when I run the code. It just puts the “value”s into each cell for the IF loop.

Hello Reddit. I am using VBA for the first time as I am trying to automate a very manual process at work. I need to do a dynamic copy and paste in order for it to work since the names of the files containing the data change every week. The first snippet of code works, but it references the file name. The second snippet is where I try to include a dynamic reference using “ThisWorkbook”, but it doesn’t work. I have tried a bunch of different variations and I am just getting the “Runtime Error ‘9’: Subscript out of range” error anytime I try to reference sheet 3 in the workbook that I am running the macro in. Please let me know how I can make this work. Thank you so much! 

' Copy data

Dim sourceFile As String

Dim wbSource As Workbook

sourceFile = Application.GetOpenFilename( _

FileFilter:="Excel Files (*.xls; *.xlsx; *.xlsm), *.xls; *.xlsx; *.xlsm", _

Title:="Select the Source File")

Set wbSource = Workbooks.Open(sourceFile)

Range("A2").Select

Range(Selection, Selection.End(xlToRight)).Select

Range(Selection, Selection.End(xlDown)).Select

Selection.Copy

 ' Paste data without dynamic reference

Windows("6W Public Daily Close - NovQTD.xlsx").Activate

Sheets(3).Activate

Range("A2").Select

ActiveSheet.Paste

' Copy Data

Dim sourceFile As String

Dim wbSource As Workbook

sourceFile = Application.GetOpenFilename( _

FileFilter:="Excel Files (*.xls; *.xlsx; *.xlsm), *.xls; *.xlsx; *.xlsm", _

Title:="Select the Source File")

Set wbSource = Workbooks.Open(sourceFile)

Range("A2").Select

Range(Selection, Selection.End(xlDown)).Select

Range(Selection, Selection.End(xlToRight)).Select

Selection.Copy

 ' Pasting Data with dynamic reference

ThisWorkbook.Activate

Set wsTarget = ThisWorkbook.Sheets(3)

wsTarget.Range("A2").Paste

Hi Reddit
I hope you can help me. I have a process where people should fill out a form in Excel, and when clicking a macro button, it should:

1. Copy the Workbook and save it under a new name that is in the field "B7" (both the original and the copy are saved in SharePoint).
2. Clear the original so it's ready to be filled out again.
3. Close both the original and new Workbooks.

The problem is that everything works except the part where it doesn't close the duplicate workbook. I also have another macro for Mac, but that one works like a charm. So now I wanted to try one that just handles the users using Windows. I also had to redact some of the URL due to company policy.

I hope you can help me, and my VBA code is as follows:

Sub Save_Duplicate_And_Clear_Original_Windows()

Dim vWBOld As Workbook

Dim vWBNew As Workbook

Dim ws As Worksheet

Dim filename As String

Dim sharepointURL As String

Dim filePath As String

' Check if the operating system is Windows

If InStr(1, Application.OperatingSystem, "Windows", vbTextCompare) = 0 Then

MsgBox "This macro can only be run on Windows.", vbExclamation

Exit Sub

End If

' Get the active workbook

Set vWBOld = ActiveWorkbook

' Get the worksheet name from cell B7

On Error Resume Next

Set ws = vWBOld.Worksheets("Sheet1")

On Error GoTo 0 ' Reset error handling

If ws Is Nothing Then

MsgBox "Worksheet 'Sheet1’ not found.", vbExclamation

Exit Sub

End If

filename = ws.Range("B7").Value

If filename = "" Then

MsgBox "Filename in cell B7 is empty.", vbExclamation

Exit Sub

End If

' Create a new workbook as a copy of the original

Set vWBNew = Workbooks.Add

vWBOld.Sheets.Copy Before:=vWBNew.Sheets(1)

' Set the SharePoint URL

sharepointURL = "http://www.Sharepoint.com/RedaktedURL”

' Construct the full file path with the new name

filePath = sharepointURL & filename & ".xlsm"

' Save the workbook with the new name

On Error Resume Next

vWBNew.SaveAs filename:=filePath, FileFormat:=xlOpenXMLWorkbookMacroEnabled

If Err.Number <> 0 Then

MsgBox "Error saving the new workbook: " & Err.Description, vbCritical

vWBNew.Close SaveChanges:=False

Exit Sub

End If

On Error GoTo 0 ' Reset error handling

' Clear the specified ranges in the original workbook

If ws.Range("B5").Value <> "" Then

With ws

.Range("B5:D5").ClearContents

.Range("B7").ClearContents

End With

End If

' Save and close the original workbook

Application.DisplayAlerts = False

vWBOld.Save

vWBOld.Close SaveChanges:=True

Application.DisplayAlerts = True

' Close the new workbook

On Error Resume Next

vWBNew.Close SaveChanges:=False

If Err.Number <> 0 Then

MsgBox "Error closing the new workbook: " & Err.Description, vbCritical

End If

On Error GoTo 0 ' Reset error handling

' Ensure the new workbook is closed

Dim wb As Workbook

For Each wb In Workbooks

If wb.Name = vWBNew.Name Then

wb.Close SaveChanges:=False

Exit For

End If

Next wb

End Sub

They are shutting down all COM Add-ins - which includes VBA in New Outlook. New Outlook is supposedly being rolled out completely in March 2025, moved back from December 2024. How will you replace your basic VBA code in excel that does things like send an e-mail? How will you replace e-mail buttons, macros, or other functions in new Outlook? Switch e-mail programs to something that supports VBA?

It seems to be only a matter of time before VBA for excel is also force deprecated.

Hi! New to VBA! I am trying to rename sheets in excel using a list of dates provided in the same workbook but different sheet and wondering if there is a way to create/modify my existing code (code below) to do this.

Thanks!

Code for creating multiple sheets: 

Sub CreateMultipleWorksheet()

Dim Num As Integer
Dim WS_Name As String
Dim Rng As Range
Dim Cell As Range

On Error Resume Next
Title = "Create Multiple Similar Worksheets"

WS_Name = Application.InputBox("Name of Worksheet to Copy", Title, , Type:=2)
Num = Application.InputBox("Number of copies to make", Title, , Type:=1)

For i = 1 To Num
Application.ActiveWorkbook.Sheets(WS_Name).Copy After:=Application.ActiveWorkbook.Sheets(WS_Name)
Next

End Sub

Hi comrades. Got another show and tell for you. I added this to my personal workbook, with a button on my toolbar, and now colleagues monstrous excel formulas don't frighten me any more. It breaks excel formulas into multiple lines.

Function BeautifyString(Inputstring As String) As String

' Purpose: Mimics some of the behaviour of FormulaBeautifier, by inserting indented new lines into a string.
' Origin: Made by Joseph in December 2024
' Limitations: Contains no error handling. Use with caution.

Dim i As Integer
Dim NewLineIndented(0 To 6) As String
Dim InputPart As String

'Pre-compute strings for indentation levels
For i = 0 To 6
    NewLineIndented(i) = Chr(10) & Application.WorksheetFunction.Rept(" ", i * 4)
Next i

Dim StringLength As Integer
Dim IndentLevel As Integer
IndentLevel = 0
StringLength = Len(Inputstring)

'Make an array to hold the resulting string.
Dim OutputParts() As String
ReDim OutputParts(0 To StringLength)

'Consider each caracter in the input string.
For i = 1 To StringLength
InputPart = Mid(Inputstring, i, 1)
Select Case InputPart
    Case Is = "("
        IndentLevel = IndentLevel + 1
        OutputParts(i) = "(" & NewLineIndented(IndentLevel)
    Case Is = ")"
        IndentLevel = IndentLevel - 1
        OutputParts(i) = ")" & NewLineIndented(IndentLevel)
    Case Is = ","
        OutputParts(i) = "," & NewLineIndented(IndentLevel)
    Case Else
        OutputParts(i) = InputPart
End Select
Next i

'Join all the parts together into a string
BeautifyString = Join(OutputParts, "")


End Function


Sub BeautifyFormula()
  Dim Inputstring As String, Outputstring As String
  Inputstring = ActiveCell.Formula
  Outputstring = BeautifyString(ActiveCell.Formula)
  ActiveCell.Formula = Outputstring
End Sub

Saturday, November 30 - Friday, December 06, 2024

###Top 5 Posts

###Top 5 Comments

Hi everyone,

I am pretty new to using vba and I am trying to return a static date (the date when something was completed into column A when the formula in column c is changed to “Completed”

The formula for context:

=IF(AND(O1 = 1, P1 = 1), “Complete”, “Incomplete”)

If anyone could assist me I would be very grateful