I created a macro that performs a click event on a website. The click event alters a div element. When the div element is altered, I want the macro to iterate through the div element.

The macro works when I step into code, but I get "Object variable or With block variable not set" when I don't interrupt the macro.

Does anyone know how to check if the new element is there/dom is complete?

I tried using readystate of the element but that doesn't seem to work. My other thought was to check if the element was there via a loop, but if the site was to change I could end up with an infinite loop.

I appreciate the help in advance.

I’ve created a form (the first of many) that has a number of text boxes that correspond to the different fields of a table. The users will fill in the text boxes appropriately and then hit the submit button. I had some of them run through it and they said it would be helpful to show the last created record in the table on the form. I don’t even know where to start with this. I’ve googled for a few hours at this point and I can’t seem to find any examples of anyone else asking about this. I have gotten exactly nowhere and any help would be appreciated.

Edit: It was suggested I post the code for my form. The top part is mostly some stuff from ChatGPT that does not work. The bottom part is my submit button that works perfectly.

Option Compare Database Public db As DAO.Database Public TBL As DAO.Recordset

Private Sub Form_Load() Dim sql As String Dim LBL As Label

Set db = CurrentDb

sql = "SELECT TOP 1 * FROM barcodeEngines ORDER BY ID DESC"


Set TBL = db.OpenRecordset(sql)

Set LBL = previousCheckTimeDisplay
LBL.Caption = rs!Time
Set LBL = Check01Display
LBL.Caption = rs!Check01



rs.Close

End Sub

Private Sub Submit_Barcode_Button_Click()

Set TBL = CurrentDb.OpenRecordset("barcodeEngines")

TBL.AddNew TBL!Time = Now TBL!Check01 = Me.C01Comment TBL!DoNotCheck01 = Me.DNC01Comment TBL!Check02 = Me.C02Comment TBL!DoNotCheck02 = Me.DNC02Comment TBL!BE01 = Me.BE01Comment TBL!BE02 = Me.BE02Comment TBL!checkedBy = Initials TBL.Update

DoCmd.Close

End Sub

I am extremely new, so I am expecting this problem is simple. But here it goes:

I have abruptly taken over purchasing, as our previous purchaser had a stroke. He was doing paper everything, I am trying to move my company digital. I tackled this head-on, but I don't know a damn thing about VBA.

I am trying to make this purchase order sheet generate the number as listed in cell S3, save a copy of the sheet with the name "PO TD" + whatever number is currently on the sheet, and then it incriminates the number up 1, and then saves so that the next time the document is opened, it's already at the next purchase order number for our shop.

So far, all of that works except the number being in the file name. No matter what I change, it just saves as "PO TD" every time. Eventually, I would also like it to be able to pull the vendor name as listed in cell A3, and make THAT the name (so it would be A3 + S3 = the file name when saved as a copy). But that's another battle.

Code:

Sub filename_cellvalue_PO_Master()
Dim Path As String
Dim filename As String
Dim branch As String
Path = "R:\engineering\data\QUICKREF\INWORK\2 Tool & Die Purchase Order's by Vendor\"
filename = Range("S3")
With ActiveWorkbook
.SaveCopyAs filename = filename & ".xlsm"
End With
Range("S3").Value = Range("S3") + 1
ActiveWorkbook.Save

End Sub

I have this problem with the macro, where the macro is saved in cloud and when my friend tries to use it it gives him bug and the option to debug it, which bug shows the last user that used it, like if Ivan has use it last, it show his name and if you change it to your user name to use it the VBA code you can continue use it, I mean you can technically still use it but I just want make it more easier and less annoying.

Hi all,

I am practicing VBA for data reconciliation. In my Macro, I compare data in column B between Book 1 and Book 2, if Book 1 equal to Book 2 then will mark "good" in column C and mark "Bad" if vice versa.

It run good if the data sequence between Book 1 and Book 2 are the same but cannot function as expected when the data sequence between Book 1 and Book 2 are different. Given the data between two columns are still the same, how to revise the Macro to get the job done when the data sequence are different?

Code and result attached in comment 1 and 2 as cannot upload picture here. Many thanks.

Hi,

I'm currently trying to replace the first page in a document with the same page from another. Therefor I use the find function to search for the table of contents header and set my range to the first character of the document up to the position of the header, When trying to achieve this the code crashes every single time when trying to set the range.

I've tried multiple ways to debug this, but everything seems fine up to that point. Both my start and end of my range are Long and the end is smaller then the last position of the doc.

Does anybody here have any idea on what the problem may be?

Sub replaceFrontpage()
    Dim pathSource As String
    Dim pathTarget As String
    pathSource = "path.docx"
    pathTarget = "path.docx"
    
    On Error GoTo ErrorHandler
    
    Dim WordApp As Object
    Dim sourceDoc As Object
    Dim targetDoc As Object
    Dim rng As Range
    Dim searchRange As Object
    Dim rangeStart As Long
    Dim rangeEnd As Long
    
    Set WordApp = CreateObject("Word.Application")
    Set rng = Nothing
    
    Call clearDebug(1)
    Debug.Print "Starting replacing front page"
    Set sourceDoc = WordApp.documents.Open(pathSource)
    Debug.Print "opened Source"
    Set targetDoc = WordApp.documents.Open(pathTarget)
    Debug.Print "opened Target"
    
    'Find Range
    Set searchRange = sourceDoc.content
    With searchRange.Find
        .Text = "Inhaltsverzeichnis"
        Debug.Print "Start Find"
        .Execute
        If .Found = True Then
            ' Select the range from the start of the document to the found text
            Debug.Print sourceDoc.content.Start & " " & searchRange.End
            Debug.Print TypeName(sourceDoc.content.Start)
            rangeStart = sourceDoc.content.Start
            Debug.Print TypeName(searchRange.End)
            rangeEnd = searchRange.End
            Set rng = sourceDoc.Range(Start:=0, End:=5)
            'Debug.Print rng.Start & " " & rng.End
            rng.Copy
            Debug.Print "copied"
        End If
    End With

    ' Find the text "Inhaltsverzeichnis" in the target document
    With targetDoc.content.Find
        .Text = "Inhaltsverzeichnis"
        .Execute
        If .Found = True Then
            ' Select the range from the start of the document to the found text
            Set rng = targetDoc.Range(Start:=targetDoc.content.Start, End:=.End)
            rng.Paste
            Debug.Print "pasted"
        End If
    End With
    
    sourceDoc.Close SaveChanges:=wdDoNotSaveChanges
    targetDoc.Close SaveChanges:=wdSaveChanges
    Exit Sub

ErrorHandler:
    Debug.Print "An Error has occured!"
    If Not sourceDoc Is Nothing Then sourceDoc.Close SaveChanges:=False
    If Not targetDoc Is Nothing Then targetDoc.Close SaveChanges:=False
    If Not WordApp Is Nothing Then WordApp.Quit
    Debug.Print "The Word document was closed."
    'wsStart.Cells(lineExcel, 5).value = "! nicht definierter Fehler aufgetreten !"
    Exit Sub
    
End Sub

I apologise if this post doesn't provide enough context, but besides providing the entire file with a lot of identifying information, I'm not sure how to better present this issue than the image attached int he comments.

I have a userform with a listbox, and when the user clicks OK, the code is meant to check whether the form has been filled out correctly before continuing. At least one item from the AssetList should be selected, and I'm checking for this in the code highlighted in yellow.

If WorksNumForm.AssetList.ListIndex = -1

However, even when no item is selected from the list, it is returning 0, essentially skipping my error check, and I have no idea why. Could anyone shed some light on this?

I have the following code excerpt to sort my data in a specific sequence:

'Sorts the worksheets
For i = 1 To UBound(vReport)
    
    'So no error triggers in case there are no entries
    On Error Resume Next
        Worksheets(vReport(i)).AutoFilter.Sort.SortFields.Clear
    On Error GoTo 0
    
    'Assumes the header is in the first row
    If Not Worksheets(vReport(i)).AutoFilterMode Then
        Worksheets(vReport(i)).Rows(iREPRowHead & ":" & iREPRowHead).AutoFilter
    End If
    
    'First sorts by ID and then by everything else
    Worksheets(vReport(i)).AutoFilter.Sort.SortFields.Add2 Key:= _
        Worksheets(vReport(i)).Range(Num2Let(iREPColNum) & iREPRowStart & ":" & Num2Let(iREPColNum) & EndRow(Worksheets(vReport(i)), iREPColEnd)), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        
    'Sorts by everything else
    For j = 1 To UBound(vCoordinateMapping, 2)
        Worksheets(vReport(i)).AutoFilter.Sort.SortFields.Add2 Key:= _
            Worksheets(vReport(i)).Range(Num2Let(vCoordinateMapping(2, j)) & iREPRowStart & ":" & Num2Let(vCoordinateMapping(2, j)) & EndRow(Worksheets(vReport(i)), iREPColEnd)), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    Next j
        
    With ActiveWorkbook.Worksheets(vReport(i)).AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Next i

On the line of code below I get the Error 438 - Object doesn't support this property or Method:

    'First sorts by Journal ID and then by everything else
    Worksheets(vReport(i)).AutoFilter.Sort.SortFields.Add2 Key:= _
        Worksheets(vReport(i)).Range(Num2Let(iREPColNum) & iREPRowStart & ":" & Num2Let(iREPColNum) & EndRow(Worksheets(vReport(i)), iREPColEnd)), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

While I also know that it would appear on the next line of code within the j loop, but we never reach this point. In order to simplify the code, imagine what this is really saying is:

    'First sorts by Journal ID and then by everything else
    Worksheets(vReport(i)).AutoFilter.Sort.SortFields.Add2 Key:= _
        Worksheets(vReport(i)).Range("P2:P3000"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

At this stage I still get the error, so its not an issue of the way I defined the range (I tested that). Even more confusingly this code actually works on one machine (the one with the newer Excel), but doesn't on the one with the older Excel. Any ideas?

EDIT:

Solution found, get this Add2 works only on newer version of Excel, I should have used Add. Ufff

https://stackoverflow.com/questions/53833429/add2-generates-run-time-error-438-object-doesnt-support-this-property-or-me

Hi. I write this code for SolidWorks API using VBA For some reason i keep getting runtime error 9: Subscript is out of range on Length(i) = sketchsegment.getlength() I dont understand why. From.mh understanding Length(i) is a dynamic array so how can it be out of range? Can anyone help explain why this happens?

Option Explicit

Dim swApp As SldWorks.SldWorks 'Sets Application to Solidworks and allows intelisense

Dim swModel As SldWorks.ModelDoc2 'A variable to determine what model document we are workong in

Dim configNames() As String 'A string array of Config names

Dim swConfig As Boolean

Dim LineSelect As Boolean

Dim swSketch As SldWorks.Sketch

Dim SelectionManager As Object

Dim SketchSegment As Object

Dim Length() As Double

Sub main()

Set swApp = Application.SldWorks 'Sets Application to Solidworks and allows intelisense

Set swModel = swApp.ActiveDoc 'Sets model to currently active document

'Get configuration names

configNames = swModel.GetConfigurationNames 'Gets names of configurations and inputs it in configNames array

'Print configNames(For testing)

Dim i As Long

For i = 0 To UBound(configNames)

Debug.Print configNames(i)

Next i

'Selects and gets length of defining line

i = 0

For i = 0 To UBound(configNames)

swConfig = swModel.ShowConfiguration2(configNames(i)) 'Switches to each configuration in part/Assembly



Set SelectionManager = swModel.SelectionManager 'Allows access to selection



LineSelect = swModel.Extension.SelectByID2("Line1@Sketch1", "EXTSKETCHSEGMENT", 0, 0, 0, False, 0, Nothing, 0) 'Selects line 1 in sketch 1 (Rename with name of specifik line)



Set SketchSegment = SelectionManager.GetSelectedObject2(1) 'Gets the selected object



Length(i) = SketchSegment.GetLength() * 1000 'Gets length of selected object(Line1@Sketch1) in meters and multiplies by 1000 for mm



Debug.Print Length(i) 'Prints Length(For testing)

Next i

End Sub

I ran the line of text below at the cmd to instal the MSCOMCTL.OCX file. "regsvr32 C:\Windows\System32\mscomctl.ocx "

But the registration instead returns the error below.

"the module "C:\Windows\System32\mscomctl.ocx" was loaded but the call to DllRegisterServer failed with error code 0x80004005. for more information about this problem, search online using error code as a search term."

I have already pasted the file in the System32 folder.

Concerning the error, i have tried to google for this erorr code's solution but what i get is a bunch of solutions but specifically game-related.

Any reference on how to resolve this issue?

Edited: My intention with registering the mscomctl.ocx file is to be able to add it to the userform controls, So that i can add a timedatepicker or monthview popup on the userform.

I don't want to create a date time picker using another userform.

If there's another way to instal a third party control among my userform controls, i will appreciate that.

NB: I am using Excel 2021 ver.

Saturday, November 02 - Friday, November 08, 2024

###Top 5 Posts

###Top 5 Comments

Hello,

I have programming experience with VBA and other languages, and knowledge in CS.

I need a book/resources to learn how VBA works under the hood, how it interacts with microsoft or whatever.

I really want to get a deep theoretical knowledge.

Secondly, I want to learn how to become an expert in VBA, the most advanced book that I can read.

I have tried to find these on google and reddit, but no luck.

I am currently using VBA for excel but for any other software is ok.

Thank you

Warning: I know nothing about coding so please talk to me like I am 5

Hi all I have a dataset of 24,000 people including varying details such as first name, last name, address, email, phone, mobile etc. a lot of these are duplicates but could be spelled differently, phone number may be in mobile column, there may be typos etc. obviously this would be tedious to search through manually, though I am currently working through the obvious matches (the ones that are completely identical) to reduce the dataset so that when I get the macro running it will run even just slightly faster. So question is: how do I create a macro that will compare each row to the rows below it and highlight (also would be helpful if it explained the matches in the black end column) the matches BUT it should only match if 2 of the criteria match for eg. Phone and first name, or email and phone, or first and last name etc. I’ve tried getting chat GPT to assist but it doesn’t seem to be able to settle 2 requirements: 1. That 2 criteria need to match for it to be a match (keeps highlighting all the same last name without anything else matching - though it does match 2+ criteria for some) and 2. I think it’s only matching when the cells are in the same column i.e. A2 matches A3 but it won’t check if G2 matches H3 which would be necessary given some of the names are just straight up written in reverse (first name is the last name and visa versa) plus phone sometimes has the mobile or vice versa.

The code that is almost successful used fuzzy matching and the levelshtein distance. I couldn’t copy and paste it in here because of ‘…’ or something? I don’t understand what reddit was saying there so if anyone knows how to fix that, I’d really appreciate that advice also 😊

ETA: apparently the post was removed because I didn’t show that I’ve tried to fix this myself… not sure how I can show that. I asked Chat GPT a few variants of the same question, the code works apart from it cycling through only the same columns (e.g. if a2&a5 match its a match but it won’t catch if a2&b5 match) I fixed it to make it more efficient by only checking the rows after the row it’s on to avoid creating more work… is that enough explanation? I don’t know enough about code to explain what I’ve done and couldn’t paste the code in here 😅

This is the code that is almost successful:

Sub FindFuzzyRowMatches() Dim rng As Range Dim row1 As Range, row2 As Range Dim col1 As Range, col2 As Range Dim similarity As Double Dim threshold As Double Dim matchMessage1 As String, matchMessage2 As String Dim i As Integer, j As Integer Dim matchCount As Integer

‘ Set the range where you want to find matches (adjust as needed)
Set rng = Selection ‘ Uses the currently selected range
threshold = 0.8 ‘ Set similarity threshold (0 to 1, where 1 is an exact match)

‘ Loop through each row in the range
For Each row1 In rng.Rows
    If Application.WorksheetFunction.CountA(row1) > 0 Then
        For Each row2 In rng.Rows
            ‘ Compare only rows after the current row to avoid duplicate comparisons
            If row1.Row < row2.Row Then
                If Application.WorksheetFunction.CountA(row2) > 0 Then
                    matchMessage1 = “Matched cells: “
                    matchMessage2 = “Matched cells: “
                    matchCount = 0

                    ‘ Loop through columns A to G for both rows
                    For i = 1 To 7 ‘ Columns A to G (1 to 7)
                        ‘ Compare the same column in both rows (ensuring similar data is matched)
                        If Not IsEmpty(row1.Cells(1, i).Value) And Not IsEmpty(row2.Cells(1, i).Value) Then
                            similarity = GetSimilarity(Trim(LCase(row1.Cells(1, i).Value)), Trim(LCase(row2.Cells(1, i).Value)))
                            
                            ‘ Check if similarity is above threshold
                            If similarity >= threshold Then
                                ‘ Update match message with cell addresses
                                matchMessage1 = matchMessage1 & row1.Cells(1, i).Address & “, “
                                matchMessage2 = matchMessage2 & row2.Cells(1, i).Address & “, “
                                matchCount = matchCount + 1
                                
                                ‘ Highlight matching cells
                                row1.Cells(1, i).Interior.Color = RGB(255, 255, 0) ‘ Highlight in row1
                                row2.Cells(1, i).Interior.Color = RGB(146, 208, 80) ‘ Highlight in row2
                            End If
                        End If
                    Next i
                    
                    ‘ Only log as a match if there are at least 2 matching cells
                    If matchCount >= 2 Then
                        ‘ Trim the final comma and space from the match messages
                        matchMessage1 = Left(matchMessage1, Len(matchMessage1) - 2)
                        matchMessage2 = Left(matchMessage2, Len(matchMessage2) - 2)
                        
                        ‘ Write match messages in Column H for both rows
                        row1.Cells(1, 9).Value = “Row “ & row1.Row & “ matches with Row “ & row2.Row & “: “ & matchMessage1
                        row2.Cells(1, 9).Value = “Row “ & row2.Row & “ matches with Row “ & row1.Row & “: “ & matchMessage2
                    End If
                End If
            End If
        Next row2
    End If
Next row1

End Sub

‘ Function to calculate similarity between two strings using Levenshtein distance Function GetSimilarity(str1 As String, str2 As String) As Double Dim len1 As Long, len2 As Long Dim i As Long, j As Long Dim distance() As Long Dim cost As Long

len1 = Len(str1)
len2 = Len(str2)
ReDim distance(len1, len2)

For i = 0 To len1
    distance(i, 0) = i
Next i

For j = 0 To len2
    distance(0, j) = j
Next j

For i = 1 To len1
    For j = 1 To len2
        If Mid(str1, i, 1) = Mid(str2, j, 1) Then
            cost = 0
        Else
            cost = 1
        End If
        distance(i, j) = Application.Min(distance(i - 1, j) + 1, _
                                        distance(i, j - 1) + 1, _
                                        distance(i - 1, j - 1) + cost)
    Next j
Next i

‘ Calculate similarity (1 - normalized Levenshtein distance)
GetSimilarity = 1 - (distance(len1, len2) / Application.Max(len1, len2))

End Function

Hi all. Sorry if I'm a bit vague in describing what I'm after. I'm right in the early stages of planning my approach.

I have a three column table. Each unique combination of col A and col B should return a specific Col C value.

I want a function that takes A and B and looks up C. I'm spoiled for choice with how to do this. I could make the whole thing a pivot table, and grab it from the cache, or I could use any of a variety of application.worksheetfunctions. Either filter, or xlookup.

I feel like I'm missing the "smart money" solution though. Can I load the whole table into a VBA array, and lookup the values without touching the worksheet?

Can anyone tell me what Char code the backtick is as I have NEVER been able to submit code into this sub correctly. Either that or the ASCII code. Thanks.

Sub CustomerColor()

  Dim SheetName As String
  Dim Config As Worksheet
  Dim CompanyList As Variant

  SheetName = "Config"
  Set Config = Worksheets(SheetName)

  CompanyList = Array(Config.Range("H2"), Config.Range("H3"), Config.Range("H4"), Config.Range("H5"), Config.Range("H6"), Config.Range("H7"), Config.Range("H8"), Config.Range("H9"), Config.Range("H10"), Config.Range("H11"), Config.Range("H12"), Config.Range("H13"), Config.Range("H14"), Config.Range("H15"), Config.Range("H16"), Config.Range("H17"), Config.Range("H18"), Config.Range("H19"), Config.Range("H20"), Config.Range("H21"), Config.Range("H22"))

End Sub

As of right now this is what I have and it works.. I am able to pull the name of the company I am looking for from my list of customers. But manually doing this for roughly 200 strings seems like an awful idea. I am wondering if there is a better way to do this in VBA?

I'm trying to build an add it, that imports another excel, or .csv file into a sheet so I can run code against it. It works in development. Here is that code:

Private Sub CommandButton1_Click()

Dim ws As Worksheet

Dim csvPath As String

Dim newSheetName As String

Dim nextRow As Long

newSheetName = "TPTData" ' The target sheet name

' Open file dialog to select Excel or CSV file

With Application.FileDialog(msoFileDialogFilePicker)

.Title = "Select Excel or CSV File"

.Filters.Clear

.Filters.Add "Excel Files", "*.xls; *.xlsx; *.xlsm", 1

.Filters.Add "CSV Files", "*.csv", 2

.AllowMultiSelect = False

If .Show = -1 Then

csvPath = .SelectedItems(1)

Else

MsgBox "No file selected.", vbExclamation

Exit Sub

End If

End With

' Check if the "TPTData" sheet already exists

On Error Resume Next

Set ws = ThisWorkbook.Worksheets(newSheetName)

On Error GoTo 0

' If the sheet doesn't exist, create it

If ws Is Nothing Then

Set ws = ThisWorkbook.Worksheets.Add

ws.Name = newSheetName

nextRow = 1 ' Start at the first row if the sheet was newly created

Else

' If the sheet exists, find the next empty row in column A

nextRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1

End If

' Clear any content in the destination range starting at nextRow

ws.Range(ws.Cells(nextRow, 1), ws.Cells(ws.Rows.Count, ws.Columns.Count)).Clear

' Check if the selected file is CSV or Excel

If Right(csvPath, 3) = "csv" Then

' Import the CSV data

With ws.QueryTables.Add(Connection:="TEXT;" & csvPath, Destination:=ws.Cells(nextRow, 1))

.TextFileParseType = xlDelimited

.TextFileConsecutiveDelimiter = False

.TextFileTabDelimiter = False

.TextFileSemicolonDelimiter = False

.TextFileCommaDelimiter = True

.TextFilePlatform = xlWindows

.Refresh BackgroundQuery:=False

End With

Else

' Import Excel data

Dim wb As Workbook

Set wb = Workbooks.Open(csvPath)

wb.Sheets(1).UsedRange.Copy

ws.Cells(nextRow, 1).PasteSpecial xlPasteValues

wb.Close False

End If

' Apply date format to column B

ws.Columns("B:B").NumberFormat = "mm/dd/yyyy" ' Change the format as needed

' Remove the first two rows if this is an additional import

If nextRow > 1 Then

ws.Rows("1:2").Delete

End If

ws.Columns.AutoFit

MsgBox "Data imported successfully into " & newSheetName & "!", vbInformation

End Sub

The moment I turn it into an add in (via compiling with innos, and installing into the users add-in file) the sheet looks as if it's being imported, it asks me if i want to keep the large amount of data on the clipboard. If i press no, it tells me the data has been imported, but there's no new sheet and no new data. If I press yes, I keep the data and the code works. I don't want this, as the user will undoubtedly press no.

I have also tried:

Private Sub CommandButton1_Click()

Dim ws As Worksheet

Dim csvPath As String

Dim newSheetName As String

Dim nextRow As Long

newSheetName = "TPTData" ' The target sheet name

' Open file dialog to select Excel or CSV file

With Application.FileDialog(msoFileDialogFilePicker)

.Title = "Select Excel or CSV File"

.Filters.Clear

.Filters.Add "Excel Files", "*.xls; *.xlsx; *.xlsm", 1

.Filters.Add "CSV Files", "*.csv", 2

.AllowMultiSelect = False

If .Show = -1 Then

csvPath = .SelectedItems(1)

Else

MsgBox "No file selected.", vbExclamation

Exit Sub

End If

End With

' Check if the "TPTData" sheet already exists

On Error Resume Next

Set ws = ThisWorkbook.Worksheets(newSheetName)

On Error GoTo 0

' If the sheet doesn't exist, create it

If ws Is Nothing Then

Set ws = ThisWorkbook.Worksheets.Add

ws.Name = newSheetName

nextRow = 1 ' Start at the first row if the sheet was newly created

Else

' If the sheet exists, find the next empty row in column A

nextRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1

End If

' Clear any content in the destination range starting at nextRow

ws.Range(ws.Cells(nextRow, 1), ws.Cells(ws.Rows.Count, ws.Columns.Count)).Clear

' Check if the selected file is CSV or Excel

If Right(csvPath, 3) = "csv" Then

' Use Workbooks.OpenText for importing CSV data without using clipboard

Dim csvWorkbook As Workbook

Workbooks.OpenText Filename:=csvPath, Comma:=True

Set csvWorkbook = ActiveWorkbook

' Copy data from the opened CSV file directly to the target sheet

Dim sourceRange As Range

Set sourceRange = csvWorkbook.Sheets(1).UsedRange

ws.Cells(nextRow, 1).Resize(sourceRange.Rows.Count, sourceRange.Columns.Count).Value = sourceRange.Value

' Close the CSV workbook without saving

csvWorkbook.Close False

Else

' Import Excel data directly without using clipboard

Dim wb As Workbook

Set wb = Workbooks.Open(csvPath)

Dim dataRange As Range

Set dataRange = wb.Sheets(1).UsedRange

ws.Cells(nextRow, 1).Resize(dataRange.Rows.Count, dataRange.Columns.Count).Value = dataRange.Value

wb.Close False

End If

' Apply date format to column B

ws.Columns("B:B").NumberFormat = "mm/dd/yyyy" ' Change the format as needed

' Remove the first two rows if this is an additional import

If nextRow > 1 Then

ws.Rows("1:2").Delete

End If

ws.Columns.AutoFit

MsgBox "Data imported successfully into " & newSheetName & "!", vbInformation

End Sub

I have a code I am working on, where we basically record the data for an audit, Each object is guaranteed to be audited at least once, but if it happens more than once in a year, we want a record of both. When we pre-fill the sheet we have a formula to determine how long the audit took (I$currentrow-H$currentrow) but if a 2nd audit takes place, I want to add this formula to the last row. H is added at the Audit is processed - I is manually added based on the time the audit was requested. So it has to be a formula so it will express once I is entered. The code already works as is, I just want to add this one line to insert this formula.

My current code is

--------------------------------------------------------------------------------------------------------------------:

Set targetWS = data.Worksheets("Master Sheet " & curYear)

lastrownum = LastRowWs(targetWS) + 1

Set foundcell = targetWS.Range("O" & lastrownum)

If Not foundCell Is Nothing Then

targetWS.Range("A" & foundcell.Row).Value = PrevA

targetWS.Range("B" & foundcell.Row).Value = PrevB

targetWS.Range("C" & foundcell.Row).Value = PrevC

targetWS.Range("D" & foundcell.Row).Value = PrevD

targetWS.Range("E" & foundcell.Row).Value = PrevE

targetWS.Range("F" & foundcell.Row).Value = PrevF
---------------------------------------------------------------------------------------------------------------------

What can i add to essentially get this result:
targetWS.Range("S" & foundcell.Row).Value = *IF(ISBLANK(H$lastrownum),"", I$lastrow-H$lastrownum)*

The intended outcome is to Join the values of each column of the array, but to ignore repeated values.

The test values:

|| || |123|a|1| |234|b|2| |345|a|3| |456|b|4| |567|a|1| |678|b|2| |789|a|3|

The intended outcome:

|| || |123 / 234 / 345 / 456 / 567 / 678 / 789| |a / b| |1 / 2 / 3 / 4|

I've implemented it in Excel beautifully, but I'm struggling to recreate it in VBA. Here is my attempt.

Sub JoinIndexTest()
    'Join only works on 1D arrays
    Dim arr() As Variant
    Sheet7.Range("A1:C7").Select
    arr = Sheet7.Range("A1:C7").Value

    Dim A As String, B As String, C As String

    With WorksheetFunction
        A = Join(.Transpose(.Index(arr, 0, 1)), " / ")
        B = Join(.Unique(.Transpose(.Index(arr, 0, 2))), " / ")
        C = Join(.Unique(.Transpose(.Index(arr, 0, 3))), " / ")
    End With

    Debug.Print A
    Debug.Print B
    Debug.Print C
    
End Sub

But this is the output:

123 / 234 / 345 / 456 / 567 / 678 / 789
a / b / a / b / a / b / a
1 / 2 / 3 / 4 / 1 / 2 / 3

Can someone explain to me why WorksheetFunction.Unique isn't behaving?

I have a query in Excel 2010, as an example:

On Error Resume Next
        ActiveWorkbook.Connections("OCs").Refresh
    On Error GoTo 0
        
    On Error Resume Next
        ActiveWorkbook.Connections("Stock").Refresh
    On Error GoTo 0
        
    On Error Resume Next
        ActiveWorkbook.Connections("Demands").Refresh
    On Error GoTo 0

However, it only updates the first connection, the rest do not generate.
It's strange that regardless of which connection it is, it only updates the first one.

Does anyone know how to resolve this? Because I absolutely need to update one at a time.

Hopefully the code comments explain what's going on, but essentially I'm trying to sort a 2D array so that the array rows containing the SortBy string are on the top of the array. However, it's currently taking ~6s to sort the array (~610, 4) which feels like way too long. Am I making a rookie mistake that's causing this sub to drag its feet?

Any reviewing comments on my code welcome.

Public Function SortTable(arr() As Variant, SortBy As String, Col As Long) As Variant
'Takes a 2D array, a search string, and a column number
'Returns a 2D array reordered so that the rows of the column containing the search string are at the top

    Dim size(0 To 1, 0 To 1) As Variant
    size(0, 0) = LBound(arr, 1): size(0, 1) = UBound(arr, 1)
    size(1, 0) = LBound(arr, 2): size(1, 1) = UBound(arr, 2)
    
    Dim SortedTable() As Variant
    ReDim SortedTable(size(0, 0) To size(0, 1), size(1, 0) To size(1, 1))
        
    Dim i As Long
    Dim j As Long
    Dim k As Long
    
    Dim rng As Range
    Set rng = Cells(1, "l")
    
    'e.g. 3 always equals 3rd column
    Col = Col - 1 + size(1, 0)
    
    j = size(0, 0)
    
    'Populate sorted array with rows matching the criteria
    For i = size(0, 0) To size(0, 1)
        If arr(i, Col) = SortBy Then
            For k = size(1, 0) To size(1, 1)
                SortedTable(j, k) = arr(i, k)
                rng.Offset(j - 1, k - 1) = arr(i, k)
            Next k
            j = j + 1
        End If
    Next i
    
    'Populate sorted array with remaining rows
    For i = size(0, 0) To size(0, 1)
        If arr(i, Col) <> SortBy Then
            For k = size(1, 0) To size(1, 1)
                SortedTable(j, k) = arr(i, k)
                rng.Offset(j - 1, k - 1) = arr(i, k)
            Next k
        j = j + 1
        End If
    Next i
    
    SortTable = SortedTable
    
End Function

I would like to:
FIND two paragraph marks (with the exception of those before [Speaker A])
REPLACE WITH two paragraph marks followed by a tab

What I have:

[Speaker A] Lorem ipsum dolor sit amet, consectetur adipiscing elit. Phasellus lobortis eros vitae quam dapibus, a laoreet nulla aliquam. In sollicitudin elementum quam, id posuere sem luctus

Phasellus consequat metus quis finibus tempor. Aenean dignissim et nibh quis accumsan. In orci metus, elementum quis finibus ut, mollis sit amet

Cras consequat et augue pretium tempor. Ut accumsan augue eu lacus interdum, et cursus enim pellentesque. Lorem ipsum dolor sit amet, consectetur adipiscing elit.

What I want:

[Speaker A] Lorem ipsum dolor sit amet, consectetur adipiscing elit. Phasellus lobortis eros vitae quam dapibus, a laoreet nulla aliquam. In sollicitudin elementum quam, id posuere sem luctus.

    Phasellus consequat metus quis finibus tempor. Aenean dignissim et nibh quis    accumsan. In orci metus, elementum quis finibus ut, mollis sit amet

    Cras consequat et augue pretium tempor. Ut accumsan augue eu lacus interdum, et cursus enim pellentesque. Lorem ipsum dolor sit amet, consectetur adipiscing

With the code below, Word finds and replaces till the end of the document (all good). But it then goes back to search again from the beginning, resulting in two tabs instead of one.

How do I tell it to stop searching at the end of the document?

Sub MacroTest()

With Selection.Find

.Text = "(^13^13)([!\[])"

.Replacement.Text = "\1^t\2"

.Forward = True

.Wrap = wdFindStop

.Format = False

.MatchCase = False

.MatchWholeWord = True

.MatchByte = False

.MatchAllWordForms = False

.MatchSoundsLike = False

.MatchWildcards = True

End With

Selection.Find.Execute Replace:=wdReplaceAll

End sub

So...I need to do some weird stuff with VBA. Specifically, I need to mimic a standalone application and force excel to the background as IT isn't letting me distribute anything non-VBA based.

I know this is going to involve some complex tomfoolery with the Windows API; wondering if anyone here has had to set up something similar and may have some code or a source? The one source I found in source forge threw a runtime error 5 crashing completely (I think due to being built for Windows 7 but running it in 11), and AI Bot got closer...but still no dice. Requirements include the excel instance being removed from the task bar and reappearing when all forms have been closed, an icon representing the Userform appear on the task bar (with one for each currently shown form), and the ability to minimize or un-minimize.

Yes, I'm aware this is completely unconventional and there would be 500+ more efficient routes than making excel do things that excel wasn't made for. I'm aware I could use userforms with excel perfectly visible as they were intended to be and without any presence in the taskbar. I'm aware I could just make it an Access application. I don't need the responses flooded with reasons I shouldn't try it. Just looking for insight into how to make it work anyway.

Thanks in advance!

Stupid question perhaps but I can’t find anything on the web that defines what constitutes a paragraph.  I know what a paragraph is in a book or document but how is it defined in VBA?  My guess is any text between two vbCrLf.  Depending on how it is written a sentence could be a paragraph in VBAs eyes.

Hey there,

ive got a question on your opinions: How would you try to implement templates like those in c++ in VBA? Would you just use a Variant, use Interfaces or just straight up write all functions for types? What are your reasons for it?

Im usually just using Varisnt with convert functions, but currently i need to implement a Matrix Class with the highest performance possible for all Datatypes. Variants are pretty slow so im implememting all Datatypes.

Hello all,

Arrr...Sorry I mixed up row and column previously...

I am new to VBA. I would like to ask if I want to perform a loop that if the data in the first column in workbook 1 and the first column in workbook 2 are match, than copy the whole row data from workbook2 to workbook1. In this case whether should use Do While loop or use for loop with if statement? Take these two table as example, I would like to setup a macro to lookup the data at first column and copy row 1 and 3 from Book2 to Book 1 as row 2 is not match between workbooks:

Book1:

Book2:

Thanks a lot!

Hello!

I have limited VBA experience, I've mostly got my head around these functions individually, but I don't know how to make them work together.

I have a workbook where the user will open it and click a button which will save as to a specific location. Easy as. From that point on, I need the WB to save at 5 minute intervals. If closed and reopened, it should continue to save at 5 minute intervals.

I want the button click to be the trigger to start the save intervals, using Application.OnTime, and then end the On.Time when they close the workbook.

The next time they open the workbook, I want the OnTime to resume, but it won't have the button click to trigger it.

I assume if I use Workbook_Open, it'll try to run it before they click the button the first time, but it won't have saved to the shared folder yet...

Full journey of this WB is -

• WB template updated with current data and emailed to team
• individual team members open WB, enter name and click button
• button triggers VBA to save to shared folder with specific file name, then save every 5 mins while open.

If I've massively overcomplicated this, let me know.

Cheers!

ETA Code I've been working with. I'm on mobile, hope the formatting works...

ActiveWorkbook.SaveAs FileName:=Range("File_Path") & Range("FileName_")

Public ScheduledTime As Double Public Const Interval = 300 Public Const MyProc = "SaveWB1"

Sub SaveWB1() ActiveWorkbook.Save SetOnTime End Sub

Sub SetOnTime() ScheduledTime = Now + TimeSerial(0, 0, Interval) Application.OnTime ScheduledTime, MyProc End Sub

Sub TimerOff() Application.OnTime EarliestTime:=ScheduledTime, Procedure:=MyProc, Schedule:=False End Sub

I've written a couple programs in excel vba that emulate some of the NYT word games, like strands and connections, where I create my own word plays. I want to be able to share them with friends, but the problem is that many people have Mac computers without excel.

Is there a comparable online service with spreadsheets and macros that I could use to rewrite these programs? I've looked into google sheets, but there seems to be very limited information online regarding proper syntax, so it seems like it would be difficult to learn.

I have combobox1 and combobox2. The values in combobox1 and combobox2 are to be selected by the user then they click the update button.

The code:

If Combobox1.value = "MIDDLE CLASS" then If Comboxbox2.value<>"MC-HALF DAY" and Comboxbox2.value<>"MC-HALF DAY" and Comboxbox2.value<>"MC-FULL DAY" and Comboxbox2.value<>"MC-H.D. BURS" and Comboxbox2.value<>"MC-F.D. BURS" then Msgbox "Main class and fees class are NOT matching",,"Class selection Mismatch" End if End if

I want the user to only proceed when the value in combobox2 is one of the four options above.

I populated both comboboxes with named ranges so the user has the only option of selecting the values and no typing.

Now instead the message box keeps popping up whether one of the above 4 options is selected for combobox2 or whether another combobox2 value is selected.

I have also tried to enclose the 4 options in an if not statement and use the or operator within the parenthese but the result is still the same.

If combobox1.value="BABY CLASS" then If not(combobox2.value="BC-HALF DAY" Or combobox2.value="BC-FULL DAY" Or combobox2.value="BC-H.D. BURS"... Msgbox "",,"" End if End if

Anyone here with a move around for what i want to achieve?

Edited: i have tried my best to format the code but i am not finding success with it.

Saturday, October 26 - Friday, November 01, 2024

###Top 5 Posts

###Top 5 Comments