Hello everyone, I apologize first and foremost if this is the wrong community, but I need MAJOR help. I am in Uni and working on a GenAI project to create an excel macro. I have always thought it would be cool to make a tool to look at player stats to compare last 5 games performance in points, assists, and rebounds to the lines offered by Sports books.

We are encouraged to use ChatGPT to help us, but I swear my version is dumber than average. I am utilizing Statmuse.com . I already created one macro that looks up a player number by name so that I can use the second macro to go to that players' game-log and export the November games.

I am trying to get to https://www.statmuse.com/nba/player/devin-booker-9301/game-log (just an example) and extract the November games onto a new excel sheet with four columns (Date / Pts / Reb / Ast) -- The closest I've gotten it to work is creating a new sheet and putting the column headers.

Any help would be greatly appreciated as I've been stuck and Chat has hit a brick wall that is just giving me error after error!

Hi everyone, I have a code already for one function but wanted two more similar functions for the same workbook:

Sub Worksheet_Change (ByVal Target as range)

If target.column = range(“DonorID”).Column Then Range(“DateCol”).Rows(Target.Row) = Date End if

End Sub

This code puts the date in column labeled “DateCol” if there is any value in column “DonorID”.

I wanted to add a formula that if the value in column “Decline” equals value “Widget”, it will add value “5” into column labeled “Code”. I also wanted to add a formula that if column “Code” has any value, it would put the word “No” into column labeled ”Back”. I’m an absolute noob so would be very appreciative of your help.

Hi Team

Not sure if this problem statement would require excel or VBA:

I have data on one tab in a workbook titled "1804", on this tab I have multiple rows that in column "B" have the contents "RM". I need specific data for each specific RM row moved to another tab in the workbook titled "RM". On the RM tab I need the following cells content moved from the "1804" tab:

column C contents, moved to column A (starts at cell A2) on "RM" tab

column K contents, moved to column B on "RM" tab

column M contents, moved to column C on "RM" tab

Column N contents, moved to column D on "RM" tab

Any help writing the code or formula would be greatly appreciated

Sorry if this doesn't belong here. Long time proponent of VBA for Excel and Access. I recently became aware of a feature I'm going to call Excel Script. There are pre-builts under the Automate tab.

I'm intrigued because if I'm reading this correctly I can share "scripts" with my team through O365. Anyone who's tried to share a VBA enabled doc will understand my pain.

As usual the MS documentation is a shit show. I'm trying a quick and dirty, highlight a range and invert all of the numbers (multiply by -1). This is literally three lines in VBA and I've been dicking around on the internet for over an hour trying to figure it out in "scripts".

I'm a paralegal with some limited experience with VBA, and I'm using some ChatGPT to help me fill in the gaps. Right now I'm working on creating a worksheet that will automatically calculate the ending date when calculating Speedy Trial information. So in the first column, I have drop-down options for the type of filing, and the second column will input the current date (or it can be manually changed). Then the third column will show 6 months out, and the fourth column will subtract down the days left to complete the trial.

The issues is, there will be excluded pairs to ensure the six months is calculated correctly. So for some pairs, I need the number of days between the dates generated for each of those drop down options is excluded. So for example, if I have the options "Information" and then "Amended Information" selected in two consecutive lines, I need the number of days between the two generated dates ignored in the final date shown at the end of the document, since the court does not count the day between the two as being towards the 183 days required.

Here is what I have so far, but I'm pretty sure I am missing something, but I can't tell anymore haha.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim DateColumnOffset As Integer
    Dim DropDownColumn As Long
    Dim ThirdColumnOffset As Integer
    Dim ExcludePairs As Variant
    Dim SkipCriteria As Variant
    Dim cell As Range
    
    ' Configuration
    DropDownColumn = 1            ' Column A (drop-down menu column)
    DateColumnOffset = 1          ' Offset for the date column (Column B)
    ThirdColumnOffset = 2         ' Offset for the calculated date column (Column C)

   ' Define exclusion pairs of values to skip
    ExclusionPairs = Array(Array("Ignore1", "Ignore2"), Array("ExcludeA", "ExcludeB"), Array("Skip1", "Skip2"))
    
    ' Define criteria for skipping rows (single-row criteria)
    SkipCriteria = Array("Skip1", "Skip2", "Skip3") ' Replace with actual drop-down values

    ' Check if the change occurred in the DropDownColumn (Column A)
    If Not Intersect(Target, Me.Columns(DropDownColumn)) Is Nothing Then
        Application.EnableEvents = False ' Temporarily disable events to prevent infinite loops

        ' Loop through each changed cell in the drop-down column
        For Each cell In Intersect(Target, Me.Columns(DropDownColumn))
            If Not IsExcludedPair(cell, ExcludePairs) And Not IsSkippedRow(cell, SkipCriteria) Then
                If cell.Value <> "" Then
                    ' Insert the current date in the adjacent cell (Column B)
                    cell.Offset(0, DateColumnOffset).Value = Date
                    ' Insert 183 days added to the date in Column C
                    cell.Offset(0, ThirdColumnOffset).Value = Date + 183
                Else
                    ' Clear the date if the drop-down cell is emptied
                    cell.Offset(0, DateColumnOffset).ClearContents
                    cell.Offset(0, ThirdColumnOffset).ClearContents
                End If
            Else
                ' Clear the dates if the selection matches exclusion or skipped criteria
                cell.Offset(0, DateColumnOffset).ClearContents
                cell.Offset(0, ThirdColumnOffset).ClearContents
            End If
        Next cell

        Application.EnableEvents = True ' Re-enable events
    End If

    ' Check if the change occurred in the Date Column (Column B)
    If Not Intersect(Target, Me.Columns(DropDownColumn + DateColumnOffset)) Is Nothing Then
        Application.EnableEvents = False ' Temporarily disable events

        ' Update Column C based on changes in Column B
        For Each cell In Intersect(Target, Me.Columns(DropDownColumn + DateColumnOffset))
            If IsDate(cell.Value) Then
                ' Add 183 days to the date in Column B and place it in Column C
                cell.Offset(0, ThirdColumnOffset - DateColumnOffset).Value = cell.Value + 183
            Else
                ' Clear Column C if Column B is not a valid date
                cell.Offset(0, ThirdColumnOffset - DateColumnOffset).ClearContents
            End If
        Next cell

        Application.EnableEvents = True ' Re-enable events
    End If
End Sub

' Function to check if a cell value matches an excluded pair
Private Function IsExcludedPair(ByVal cell As Range, ByVal ExcludePairs As Variant) As Boolean
    Dim Pair As Variant
    Dim i As Long

    ' Loop through the exclusion pairs
    For i = LBound(ExcludePairs) To UBound(ExcludePairs)
        Pair = ExcludePairs(i)
        If cell.Value = Pair(0) Then
            ' Check if the adjacent row matches the second half of the pair
            If cell.Offset(1, 0).Value = Pair(1) Then
                IsExcludedPair = True
                Exit Function
            End If
        ElseIf cell.Value = Pair(1) Then
            ' Check if the previous row matches the first half of the pair
            If cell.Offset(-1, 0).Value = Pair(0) Then
                IsExcludedPair = True
                Exit Function
            End If
        End If
    Next i
    
    ' If no match is found, the cell is not excluded
    IsExcludedPair = False
End Function

' Function to check if a cell value matches skipped criteria
Private Function IsSkippedRow(ByVal cell As Range, ByVal SkipCriteria As Variant) As Boolean
    Dim i As Long

    ' Loop through the skip criteria
    For i = LBound(SkipCriteria) To UBound(SkipCriteria)
        If cell.Value = SkipCriteria(i) Then
            ' Cell value matches skip criteria
            IsSkippedRow = True
            Exit Function
        End If
    Next i
    
    ' If no match is found, the row is not skipped
    IsSkippedRow = False
End Function    Dim DateColumnOffset As Integer

(This is the dummy code). The main thing I need is so ensure that I am excluding the pairs correctly, because it seems to now being doing that.

Thanks!

I know how to make a textbox and put in some text like so:

With ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 100, 100, 100, 100)
.name = "My Name"
.TextFrame2.TextRange.Characters.text = "Hello world"
End With

I know how to manipulate the text (color, size, bold/italic etc.). I wish to add an equation which is easily done manually through Insert->Equation but i would like to be able to do it through VBA. In my specific case I would like to use the big summation symbol with start and end conditions below/above it.

A workaround i have used previously is making a bunch of textboxes in a hidden sheet and then swapped them out to show the relevant one but im getting to a point where there would become a lot of different (manually made) textboxes and it just seems like an unsatisfying solution.

A point in the right direction would be appreciated.

I have a worksheet in which I compile a bunch of tables with the help of powerquery. One of the columns in the worksheet has hyperlinks, but since PQ copies the cell contents into the results table as text, I need to process this column afterwards. In order to this I have tried to catch when the query is run. After a fair amount of googling, I found a method here, and have ended up with this class module:

Option Explicit

Public WithEvents qt As QueryTable
	
Private Sub qt_BeforeRefresh(Cancel As Boolean)
	MsgBox "Please wait while data refreshes"
End Sub

Private Sub qt_AfterRefresh(ByVal Success As Boolean)
	'MsgBox "Data has been refreshed"
End Sub

this regular module:

Option Explicit

Dim X As New cRefreshQuery

Sub Initialize_It()
	Set X.qt = Framside.ListObjects(1).QueryTable
End Sub

and this event-catcher in ThisWorkbook:

Private Sub Workbook_Open()
	Call modMain.Initialize_It
End Sub

Now, the message-boxes pop up just fine when the query updates automatically or is manually updated from Data > Refresh all. However, when I click on the "Refresh"-button under the query tab in the ribbon nothing happens.

Does anyone have any idea of how I can fix this?

Hi redditors, I have an issue I am struggling with on one of my worksheets. I have some macros which serve to "filter" data to only show what correlates with the user's other spreadsheet. The part I am struggling with is hiding some rows where there is no data. This is the part of the code which is causing me trouble..

It works well until it gets to a "section" of the sheet where there are hidden rows in the (checkRow + 3, 2). For example if checkRow is line 95 and endRow is line 108, if lines 98 & 99 are hidden this hides the rows even though those rows are hidden. Essentially what I need it to do is to look at the values 3 rows down in column B of the cells visible on the screen. Does anyone have any ideas on how to work around this?

For checkRow = startRow To endRow

If ws.Cells(checkRow + 3, 2).Value <> "" And ws.Rows(checkRow).Hidden = False Then
    ws.Rows(checkRow).EntireRow.Hidden = True
    ws.Rows(checkRow + 1).EntireRow.Hidden = True
    ws.Rows(checkRow + 2).EntireRow.Hidden = True
Else
End If
Exit For

I am trying to create a script to make a picture log of 900 pictures. what i have so far is getting a 5X4 grid of pictures on 11X17 with the description in a text box below each picture. My issue is that after the first 20 pictures, the script restarts on page 1 with the next set of images. I have very little experience doing this and would really appreciate any suggestions. what i am working with is below

Sub InsertPicturesInGrid()
    Dim picFolder As String
    Dim picFile As String
    Dim doc As Document
    Dim picShape As Shape
    Dim textBox As Shape
    Dim row As Integer
    Dim col As Integer
    Dim picWidth As Single
    Dim picHeight As Single
    Dim leftMargin As Single
    Dim topMargin As Single
    Dim horizontalSpacing As Single
    Dim verticalSpacing As Single
    Dim picCount As Integer
    Dim xPos As Single
    Dim yPos As Single
    Dim captionText As String

    ' Folder containing pictures
    picFolder = "C:\Users\Dan\Desktop\Photo Log\"

    ' Ensure folder path ends with a backslash
    If Right(picFolder, 1) <> "\" Then picFolder = picFolder & "\"

    ' Initialize variables
    Set doc = ActiveDocument
    picFile = Dir(picFolder & "*.*") ' First file in folder

    ' Picture dimensions
    picWidth = InchesToPoints(2.6)
    picHeight = InchesToPoints(1.96)

    ' Spacing between pictures
    horizontalSpacing = InchesToPoints(0.44)
    verticalSpacing = InchesToPoints(0.35)

    ' Margins
    leftMargin = InchesToPoints(0) ' 0-inch from the left margin
    topMargin = InchesToPoints(0) ' 0-inch from the top margin

    ' Initialize picture counter
    picCount = 0

    ' Loop through all pictures in the folder
    Do While picFile <> ""
        ' Calculate row and column
        row = (picCount \ 5) Mod 4
        col = picCount Mod 5

        ' Calculate x and y positions relative to the margins
        xPos = leftMargin + col * (picWidth + horizontalSpacing)
        yPos = topMargin + row * (picHeight + verticalSpacing)

        ' Add a page break every 20 pictures
        If picCount > 0 And picCount Mod 20 = 0 Then
            doc.Content.InsertParagraphAfter
            doc.Content.Paragraphs.Last.Range.InsertBreak Type:=wdPageBreak
        End If

        ' Insert picture
        Set picShape = doc.Shapes.AddPicture(FileName:=picFolder & picFile, _
            LinkToFile:=False, SaveWithDocument:=True, _
            Left:=xPos, Top:=yPos, _
            Width:=picWidth, Height:=picHeight)

        ' Prepare caption text
        captionText = Replace(picFile, ".jpg", "")

        ' Insert a text box for the label
        Set textBox = doc.Shapes.AddTextbox( _
            Orientation:=msoTextOrientationHorizontal, _
            Left:=xPos + InchesToPoints(0.6), _
            Top:=yPos + picHeight + InchesToPoints(1), _
            Width:=picWidth, _
            Height:=InchesToPoints(0.3)) ' Adjust height for text box

        ' Format the text box
        With textBox
            .TextFrame.TextRange.Text = captionText
            .TextFrame.TextRange.ParagraphFormat.Alignment = wdAlignParagraphCenter
            .TextFrame.TextRange.Font.Size = 10
            .Line.Visible = msoFalse ' Remove text box border
            .LockAspectRatio = msoFalse
        End With

        ' Increment picture counter and get the next file
        picCount = picCount + 1
        picFile = Dir
    Loop

    MsgBox "Picture log done you lazy bum!", vbInformation
End Sub

Greetings. I have some coding that is being applied to a quote form that I am making. For simplicity, I have a lot of extra rows for each tab, so as to avoid having to insert rows and shifting data.

The code that I have is supposed to be hiding any row that doesn't have data within the array, so that it prints cleanly. For example, I have on row 25 a few questions regarding hours, description, hourly rates, etc. These cells should be blank, unless someone is inserting information on the row.

How can I have excel detect when there is ANY data on these rows, and therefore not hide the entire row? So even if I only fill out one cell on the row, I want it to be displayed in the print preview. REFER TO CODE.

The issue I come across is that I have to only give a single column for the range I want to hide. This would mean copying " Range("B27:B34").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True " several times and having it apply to B27:B34, C27:C34, etc. When putting an array reference, B27:I34, the rows are only displaying if there are no blank cells within the row. Although close to what I desire, I would rather it show if I have a partially filled line.

 Sub PrintA()
    
    'prints rows of data, will not print rows if column A is blank
    Application.ScreenUpdating = False
On Error Resume Next
    Range("B:I").EntireRow.Hidden = False
    
    Range("B9:B12").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True  'this is any row (except first two) that doesn't have data for Job Description
    Range("B16:B22").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True 'this is any row (except first two) that doesn't have data for Work Performed
    
    Range("F27:F34").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True 'this is any row (except first two) that doesn't have data for Labor
    Range("F45:F52").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True 'this is any row (except first two) that doesn't have data for Equipment
    Range("F58:F71").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True 'this is any row (except first two) that doesn't have data for Material
    Range("F77:F82").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True 'this is any row (except first two) that doesn't have data for Freight
    
    ActiveWindow.SelectedSheets.PrintPreview
    Range("B:I").EntireRow.Hidden = False
    
    Application.ScreenUpdating = True
    Application.ActiveSheet.Protect, AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingColumns:=False, AllowInsertingRows:=False, AllowInsertingHyperlinks:=False, AllowDeletingColumns:=False, AllowDeletingRows:=False, AllowSorting:=False, AllowFiltering:=False
End Sub

Here's the code but i keep getting run time error 9, would appreciate some help:
Sub PrintWithFilter()

Dim ws As Worksheet

Dim refCell As Range

Dim filterCell As Range

Dim startValue As Long

Dim endValue As Long

Dim currentValue As Long

Dim cellAddress As String

Dim filterAddress As String

Dim numCopies As Integer

Dim sheetName As String

Dim filterRange As Range

Dim filterValues() As Variant

Dim cell As Range

Dim i As Long

On Error GoTo ErrorHandler

' Get user inputs

sheetName = Application.InputBox("Enter the sheet name:", Type:=2)

On Error Resume Next

Set ws = ThisWorkbook.Sheets(sheetName)

On Error GoTo 0

If ws Is Nothing Then

MsgBox "Sheet name does not exist. Please check and try again."

Exit Sub

End If

cellAddress = Application.InputBox("Enter the reference cell address (e.g., K9):", Type:=2)

On Error Resume Next

Set refCell = ws.Range(cellAddress)

On Error GoTo 0

If refCell Is Nothing Then

MsgBox "Reference cell address is invalid. Please check and try again."

Exit Sub

End If

filterAddress = Application.InputBox("Enter the filter cell address (e.g., A1):", Type:=2)

On Error Resume Next

Set filterCell = ws.Range(filterAddress)

On Error GoTo 0

If filterCell Is Nothing Then

MsgBox "Filter cell address is invalid. Please check and try again."

Exit Sub

End If

startValue = Application.InputBox("Enter the starting value:", Type:=1)

endValue = Application.InputBox("Enter the ending value:", Type:=1)

numCopies = Application.InputBox("Enter the number of copies to print:", Type:=1)

' Define the filter range explicitly

Set filterRange = ws.Range(filterCell, ws.Cells(ws.Rows.Count, filterCell.Column).End(xlUp))

' Initialize the filterValues array

ReDim filterValues(1 To filterRange.Rows.Count - 1) As Variant

' Populate the filterValues array, excluding the second item

i = 1

For Each cell In filterRange.Cells

If cell.Value <> "-" Then

filterValues(i) = cell.Value

i = i + 1

End If

Next cell

' Resize the array to remove any empty elements

ReDim Preserve filterValues(1 To i - 1)

' Clear existing filters

If ws.AutoFilterMode Then ws.AutoFilterMode = False

' Apply filter with all values except "-"

filterRange.AutoFilter Field:=1, Criteria1:=filterValues, Operator:=xlFilterValues

' Loop through the range of values

For currentValue = startValue To endValue

' Set the reference cell value

refCell.Value = currentValue

' Print the sheet with the specified number of copies

ws.PrintOut Copies:=numCopies

Next currentValue

Exit Sub

ErrorHandler:

MsgBox "Error: " & Err.Description

End Sub

I would post what the filter is supposed to look like but images aren't allowed

Hi everyone,

I’m trying to create a VBA macro that filters a dataset based on a user-provided genre, calculates the average IMDb scores by year for the filtered results, and generates a chart. While most of the code seems to work, I’m running into issues with defining the correct data range after filtering.

Here’s the problematic section:

' Get the filtered data range for Year (Y), Actor (Z), and IMDb Score (AA)
Set dataRange = dataSheet.Range("Y1:AA" & dataSheet.Cells(dataSheet.Rows.Count, "Y").End(xlUp).Row).SpecialCells(xlCellTypeVisible)

The main thing is that the data range was not taking into account the filtered data and just returning the whole range (the last unfiltered row number is 5043), so I then tried to do something with .SpecialCells, which didnt work and now returns the whole row range (1,048,576). Also, the code for the graph is also not working and if it helps here is the code for filtering:

    On Error Resume Next
    dataSheet.Range("A1").AutoFilter Field:=10, Criteria1:="*" & genreInput & "*"
    On Error GoTo 0

For context, I study physics and am taking a course about advance excell, this is out of the scope of the course but I started thinking it was easier and have already sunk too many hours into it to leave it. Also, most of the code was done by Chatgpt since we havent really learned ow to do any actual VBA coding.

Thanks in advance for your help! 🙏

Hey there,

ive got a obscure Problem, where when using an InkEdit Control i want set the input character to 0 to avoid any userinput in a certain workmode. Here is the Code:

    Private Sub ConsoleText_KeyPress(Char As Long)
        If WorkMode = WorkModeEnum.Idle Then Char = 0: Exit Sub
        If PasswordMode Then 
            Select Case Char
                Case 8
                    UserInput = Mid(UserInput, 1, Len(UserInput) - 1)
                Case 32 To 126, 128 To 255
                    UserInput = UserInput & Chr(Char)
                    Char = 42 '"*""
                Case Else
            End Select
        End If
    End Sub

It runs just fine and works for the normal letters like abcde and so on, but when char is 13 or 8 (enter or backspace) it will Also run normally but still run that character in the Control. I tried an if statement to set enter to backspace to counter it. My next approach will be to create a function that cuts or adds the whole text accordingly, but before i do that i would like to know why this happens in the first place. The KeyDown and KeyUp Event have the same Condition in the first Line, just without Char = 0.

I used to work as a programmer with 8 years of experience in Excel VBA, but my knowledge has become outdated since transitioning into the E-Commerce niche 7 years ago. Now, my boss has assigned me to build a system for our small but successful company, and I need to refresh my VBA skills to handle this project effectively.

Can anyone recommend a good refresher course or a resource that covers both the fundamentals and advanced concepts of Excel VBA? I’m looking for something practical, focusing on real-world applications like data management and automation. I’m open to paid courses as long as they help me achieve my goals.

Thanks in advance for your recommendations

I have a userform that launches a second form upon completion.

This second userform has a textbox which is supposed to capture the input into a cell, and then SetFocus on the next textbox.

However, when I paste data into this textbox, nothing happens.

The input isn't captured in the cell, and the next textbox isn't selected.

I have double-checked, and I don't have EnableEvents disabled, and so I'm not sure why my Textbox Change Event isn't triggering.

This is the code I am working with:

Private Sub Company_Data_Textbox_Change()

Company_Data_Textbox.BackColor = RGB(255, 255, 255)

ActiveWorkbook.Sheets("Data Import").Range("CZ2").Value = Company_Data_Textbox.Value

Company_Turnover_Textbox.SetFocus

Interestingly, when I run this code from my VBA window, it triggers the change event fine, but it just sits there when I try to launch it in a real-world situation.

Does anyone have any thoughts on the issue?

Hello all. I’m creating a probability tree that utilizes nested loops. The last branch of the tree is making 40 to the tenth calculations and it’s freezing up excel. I get a blue spinning circle. Is vba able to handle this many calculations? Is there a better way to code a probability tree than with nested loops? Any insight is appreciated.

Saturday, November 23 - Friday, November 29, 2024

###Top 5 Posts

###Top 5 Comments

I have a worksheet that we use in our warehouse as a staffing sheet. A lot of what it does has been added piece by piece so it is kind of messy.

This was brought into VBA after the team that uses it kept on messing it up. Over and over, so we put a lot of formatting into VBA. We have 4+ technologically challenged folks using this daily.

I have a cell with a dynamic array that was highlighted had instructions next to it and somehow they still managed to mess it up. So I have been using this opportunity to not only make things better for them but to learn how to do some of this.

I am at a point the file is functional but can be slow. I feel that there are a few places it can be improved even if it means rearranging some of the code. I have also been leveraging Copilot since my company gave me access to it. So there are some things I don't understand and somethings I do.

Code is kind of long so here is a Google Drive link, https://drive.google.com/file/d/1CSYgQznliMb547ZQkps11Chh5R1xoSAg/view?usp=drive_link

I have scrubbed all the information from it and provided fakes to test with.

If anyone has suggestions on how to best (in your opinion/experience) arrange/adjust this I would love to hear it.

Lets assume my starting array is

vArray(0 to 0, 0 to 1)

Now lets say I want to extend it by 1 row on its 1st dimension, so I run this (assume lRows is 1)

vArray = Application.Transpose(vArray)
ReDim Preserve vArray(LBound(vArray, 1) To UBound(vArray, 1), LBound(vArray, 2) To UBound(vArray, 2) + lRows)
vArray = Application.Transpose(vArray)

This will now produce an:

vArray(1 to 2, 1 to 2) 

But what I would want is actually

vArray(0 to 1, 0 to 1)

What I could do, as a lazy solution would be to simply create a new array with the desired dimensions and then copy the contents of vArray into into via a loop, but I don't think this is the most elegant solution especially if it needs to be performed multiple times on big arrays. Any other solutions?

I am doing a custom function that involves finding a numbers in a range multiple times.

I settled on putting the range into an array and then checking every single entry if it's equal to my lookup value.

Here's a bit of code where UsersArray as Variant is the array created from a range of cells, lookupNr as Long is the value I'm looking for.

For i = LBound(UsersArray, 1) To UBound(UsersArray, 1)
  If UsersArray(i, 1) = lookupNr Then
    'do stuff
    Exit For
  End If
Next i

I was shocked to find this is 10x quicker than using the find function:

UsersArray.Find(What:=lookupNr, LookIn:=xlvalues, LookAt:=xlWhole)

I also tried using a dictionary but it was much slower than either of the previous options.

Is there a faster way to do it? The range can have up to 150k entries, so it takes quite a long time when I have to run the check many times.

I can sort the range however I like. Sorting by the likelihood of being the lookup number helps a lot.

How can I further optimize search time? Maybe some math trick on the range sorted from lowest to highest number?

Every millisecond helps!

Edit:
Tried a rudimentary binary search. It is faster than unsorted search, but still significantly slower than what I'm doing now (sort by probability, and search from start to end).

    Do While low < high
        mid = Int((low + high) / 2)
        If UsersArray(mid, 1) = lookupNr Then
            Set returnCell = Users.Cells(mid, 1)
            Exit Do
        ElseIf UsersArray(mid, 1) < lookupNr Then
            low = mid
        Else
            high = mid
        End If
    Loop

lastRow = wsSource.Cells(wsSource.Rows.Count, 8).End(xlUp).Row

For i = 38 To lastRow ' Data starts from row 38, adjust accordingly

If Trim(wsSource.Cells(i, 6).Value) = "" Then ' Check if column F is empty or only has spaces

wsSource.Cells(i, 8).ClearContents ' Clear the content in column H (8th column)

Else

If wsSource.Cells(i, 5).Value = "PO-RC" Then

i = i + 1 ' Increment i to skip the next row

' No need to clear the content if "PO-RC" is found, so continue the loop

End If

End If

Please help me understand why my code wouldn't skip a row

Hi guys
I am currently studying for an exam in VBA and excel and am struggling to so solve one problem in the exercises. If you have a bit of knowledge (its beginners level -so not so hard)
If you want to help out a struggling student and save my life, I would be sooo glad if you reach out!
Thanks in advance!

VBA object selection

I’ve started to learn AutoCad Vba, and after wrote couple of operations saw one problem with selecting objects. For simplify name that command as move. When I run a standard Autocad operation i can select objects for moving by two ways, 1. Select manually after operation start (if there is no chose previously) 2. Select objects before operation start (when objects are highlighted). But, in my operation I have to select objects manually, and if I had selected objects before run operation, they are reset. So, there is my question, how I can solve that problem?

Sub RotateObjectByAxis() Dim selectedObject As AcadEntity Dim selectedObjects As AcadSelectionSet

On Error Resume Next
Set selectedObjects = ThisDrawing.SelectionSets.Item("RotateSet")
If Err.Number <> 0 Then
    Set selectedObjects = ThisDrawing.SelectionSets.Add("RotateSet")
Else
    selectedObjects.Clear
End If
On Error GoTo 0
ThisDrawing.Utility.Prompt "Select object to rotate: "
selectedObjects.SelectOnScreen
If selectedObjects.Count = 0 Then
    Exit Sub
End If
Set selectedObject = selectedObjects.Item(0)

End Sub

Hey there, ive got a code that tries to add forms to a stack and then show/hide it with events. My Problem is, that the UserForm doesnt get passed as said form, but changes itself to Variant/Object/Controls.
Doing Start_Form.Show works perfectly fine and passing it to

Private Sub foo(x as Variant)
x.Show
End Sub

works too.

My Problem is here:

    Dim FormStack As Form_Stack
    Set FormStack = New Form_Stack
    Set FormStack.Stack = std_Stack.Create()
    FormStack.Stack.Add (Start_Form)

In Form_Stack:

Public WithEvents Stack As std_Stack

Private Sub Stack_AfterAdd(Value As Variant)
    Value.Show
End Sub

Private Sub Stack_BeforeDelete()
    Stack.Value.Hide
End Sub

In std_Stack:

    Public Property Let Value(n_Value As Variant)
        If Size <> -1 Then
            If IsObject(n_Value) Then
                Set p_Data(Size) = n_Value
            Else
                p_Data(Size) = n_Value
            End If
        End If
    End Property

    Public Property Get Value() As Variant
        If Size <> -1 Then
            If IsObject(n_Value) Then
                Set Value = p_Data(Size)
            Else
                Value = p_Data(Size)
            End If
        Else
            Set Value = Nothing
        End If
    End Property

'

' Public Functions
    Public Function Create(Optional n_Value As Variant) As std_Stack
        Set Create = New std_Stack
        If IsMissing(n_Value) = False Then Call Create.Add(n_Value)
    End Function

    Public Function Add(n_Value As Variant) As Long
        RaiseEvent BeforeAdd(n_Value)
        Size = Size + 1
        ReDim Preserve p_Data(Size)
        Value = n_Value
        Add = Size
        RaiseEvent AfterAdd(n_Value)
    End Function

I'm working in a project and I've noticed sometimes I get an error because what it's supposed to be a 1 dim vector, it's in reality a 2 dim array.

I've been playing around with Double arrays and Variant arrays to see if this is what generates the problem but I yet cannot understand why is this happening in my code.

Why does this happen?

How can I transform one of these 2 dim arrays into a single dim array? I've tried ReDim and ReDim Preserve but I get an error.

:(

Thanks in advance.

Hi everyone.

Trying to narrow down my next steps and would really appreciate your expertise.

I have a set of Word Templates with macroses (.dotm + VBA) which are currently accessing DB for fetching some data. No authentication in place.

I am trying to introduce a service which will be responsible for fetching the data. So the macros would perform Get/Post request. So far so good.

The problem is with authentication: I was expecting having support of Negotiate/Windows Authentication out of the box between a Microsoft Document and .Net service. But after a day of research I am not so sure.

Questions:

1. What are the recommended Authentication strategies when dealing with REST requests from VBA? I am trying to avoid Basic Authentication, but can see myself developing something with it as well.

2. Should I pursue Windows Authentication or it would be more effective to introduce an API keys?

Thank you!

I have this macro below, we use it to pull rack fuel prices into a spreadsheet. But recently its been giving us a "Run-time error '91': Object variable or With block variable not set."

I confirmed references Microsoft Scripting Runtime and Microsoft HTML Object Library are still enabled in the VB editor.

When I click debug, it highlights row 13 below ("For each tr..."). I also still find table.rack-pricing__table in Chromes developer tools at https://www.petro-canada.ca/en/business/rack-prices, which to me suggests they haven't changed anything on their end.

Anybody know why the code would arbitrarily stop working? All I know is I left for six months and came back to this error.

Code:

Sub GetTableFuel()
    Dim html As MSHTML.HTMLDocument, hTable As Object, ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Web")
    Set html = New MSHTML.HTMLDocument                  '<  VBE > Tools > References > Microsoft Scripting Runtime
    
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.petro-canada.ca/en/business/rack-prices", False
        .send
        html.body.innerHTML = .responseText
    End With
    Set hTable = html.querySelector("table.rack-pricing__table")
    Dim td As Object, tr As Object, th As Object, r As Long, c As Long
    For Each tr In hTable.getElementsByTagName("tr")
        r = r + 1: c = 15                               ' Enter this table beginning in column 15 of spreadsheet
        For Each th In tr.getElementsByTagName("th")
            ws.Cells(r, c) = th.innerText
            c = c + 1
        Next
        For Each td In tr.getElementsByTagName("td")
            ws.Cells(r, c) = td.innerText
            c = c + 1
        Next
    Next
End Sub

Any advice would be appreciated!

Hey! I’m new to VBA and need help with a homework. How do I make a user form for data input, and how do I create a button to run a macro when I click it?

I want to loop through cells to find empty ones—what’s the easiest way, and how can I make my code run automatically when I open the Excel file?

Lastly, what’s the deal with arrays for handling data, and can someone explain that to me? Plz help me out here!

I have a very specific ask.

I have an excel file where time value is pasted everyday "hh:mm" format.

The file will give incorrect results if the value is less than 8:00.

I want a solution, if anyone pastes any data with less than 8:00 into the column then the file cannot be saved.

I have tried the VBA options but none of them are working. I have tried multiple variant of the code below, but it is not working.

Is there any way to do what I need???

Sharing the code I have tried using.

******************

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim cell As Range

Dim ws As Worksheet

Dim workbookName As String

workbookName = "Excel Testing.xlsm"

If ThisWorkbook.Name = workbookName Then

Set ws = ThisWorkbook.Sheets("Sheet2") ' Your specific sheet name

For Each cell In ws.Range("A1:A10")

If IsDate(cell.Value) And cell.Value < TimeValue("08:00:00") Then

MsgBox "Time is less than 8:00 AM. File cannot be saved.", vbExclamation

Cancel = True ' Prevents saving the file

Exit Sub

End If

Next cell

MsgBox "All times are greater than or equal to 8:00 AM. File can be saved.", vbInformation

End If

End Sub

I am using the below code to check what images I have in a file by bringing back the file path and name, however my code just repeats the first file in the folder rather than going to the second, third etc.

Sub ImageCheck()

Dim sPath As String, sFileName As String

Dim i As Integer

sPath = "S:\Images\"

i = 1

Do

If Len(sFileName) = 0 Then GoTo SkipNext

If LCase(Right(sFileName, 4)) = ".jpg" Then

ThisWorkbook.Worksheets("Image Data").Range("A" & i) = sPath & sFileName

i = i + 1

End If

SkipNext:

sFileName = Dir(sPath)

Loop While sFileName <> ""

End Sub

Any help would be appreciated.