We help IT Professionals succeed at work.

VBA

12K

Solutions

4K

Contributors

Visual Basic for Applications (VBA) enables building user-defined functions (UDFs), automating processes and accessing Windows API and other low-level functionality through dynamic-link libraries (DLLs). VBA is closely related to Visual Basic and uses the Visual Basic Runtime Library, but it can normally only run code within a host application rather than as a standalone program. It can, however, be used to control one application from another via OLE Automation. VBA is built into most Microsoft Office applications.

I am running the following VBA code in Excel 2016.  Every time it runs, the results are populated on a new worksheet.  I want this code to clear anything on a single worksheet named ProjectResults and the results should always go to this same ProjectResults worksheet.

Option Explicit

 

Dim conn As ADODB.Connection

Dim rst As ADODB.Recordset

 

Sub Connect_To_SQLServer(ByVal Server_Name As String, ByVal Database_Name As String, ByVal SQL_Statement As String)

Dim strConn As String

Dim wsReport As Worksheet

Dim col As Integer

 

strConn = "Provider=SQLOLEDB;"

strConn = strConn & "Server=" & Server_Name & ";"

strConn = strConn & "Database=" & Database_Name & ";"

strConn = strConn & "Trusted_Connection=yes;"

 

Set conn = New ADODB.Connection

With conn

        .Open ConnectionString:=strConn

        .CursorLocation = adUseClient

End With

 

Set rst = New ADODB.Recordset

With rst

        .ActiveConnection = conn

        .Open Source:=SQL_Statement

       

End With

 

Set wsReport = ThisWorkbook.Worksheets.Add

With wsReport

               

        For col = 0 To rst.Fields.Count - 1

                .Cells(1, col + 1).Value = rst.Fields(col).Name

        Next col

       

        .Range("A2").CopyFromRecordset rst

       

End With

 

Set wsReport = Nothing

 

Call Close_Connections

 

End Sub

 

Private Sub Close_Connections()

 

If rst.State <> 0 Then rst.Close

If conn.State <> 0 Then conn.Close

 

'// Release Memory

Set rst = Nothing

Open in new window

0
Excel worksheet as a board game.
Problem: The worksheet is much larger than the screen size.
Objective: to show a live inset of the total chart area on the screen at all times.
Example file shows inset as pic.
EE-YachtRacingStKilda2020flagsrevis.xlsm
0
Hi

I am trying to enter a default value for a field which I have set up in design view as per the image below. When I actually enter a record into the form as per the second image that value does not get added. Rather an error does. I am not sure if this has something to do with the record source of the subform which is SELECT tblPeople.*, tblPeople.Status FROM tblPeople WHERE (((tblPeople.Status)="Enquiry"));


Design View

Form View
0
Excel worksheet has been set up as board game.
Objective:  Move the 43 inserted pics (where bottom pic is at  H1 to M7) to a stack at H1 to M7 and allow click on top pic to place it at bottom of stack.
The pics are named flag1.png to flag43.png.
EE-YachtRacingStKilda2020flags.xlsm
0
Hello Experts,

I have one docx document with some styles that I want to transfer to my Normal.dotm file.
Do you know if there is a Word VBA procedure that allows me to specify the style that I want to transfer to my Normal.dotm.

Example: SourceFile="C:\Doc" StyleName="CuztomizedStyle" TargetFile="C:\Normal.dotm.

The aim is to have CuztomizedStyle at Normal.dotm.

It would be great if I can specify multiple StyleNames, if not I will used as function and call it based on Styles number to transfer.
Example:
Sub TransferStyle(SourceFile,StyleName,TargetFile)

The final aim is to add it to my personal add-in and used whenever I want.

Thank you for your help.
0
I'm having an error parsing data into Ms Access from the notepad string , please note that the information and the problem is highly summarized to ensure that everyone is able to follow easily and a small database with one table and a form are the only objects included. the error occurs on the small code below:

For Each details In Json
     With rs
            .AddNew 

Open in new window




VBA CODE

Option Compare Database
Option Explicit

Private Sub CmdParsers_Click()
'Declaration of objects
Dim Json As Object
Dim details As Object
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim Z As Integer

'String from notepad required to parsed into a table called tblEfdReceipts
Dim intFile As Integer
Dim strFile As String
Dim strText As String
Dim strInput As String

intFile = FreeFile()
strFile = "C:\FolderName\FileName.txt"
Dim strFilename As String: strFilename = "C:\Users\chris.hankwembo\Desktop\Latest test 2020\finish.txt"
Dim strFileContent As String
Dim iFile As Integer: iFile = FreeFile
Open strFilename For Input As #iFile
strFileContent = Input(LOF(iFile), iFile)
Close #iFile
MsgBox "FileContent:" & vbCrLf & strFileContent

'Processing data from the string above

Set db = CurrentDb
    Set rs = db.OpenRecordset("tblEfdReceipts", dbOpenSnapshot, dbSeeChanges)
    Set Json = ParseJson(strFileContent)
     Z = 2
     
    ' Process data.
    
    For Each details In Json
     With rs
            .AddNew
            ![ESDTime] = details("ESDTime")
            

Open in new window

0
Excel worksheet is a board game on screen
Objective 1 is to move all boat pics back to the original position using a Reset Game button. This will need a warning window so that it is not reset by accident.

The boat pics that are scattered across the board need to be re positioned back in the spaces near the boat pics on the dark blue square.

Objective 2 Protect the sheet while allowing the boat pics to be moved, the Roll dice to be clicked, the cards to be licked and the  Reset Game button to be clicked.
ee-example---YachtRacingStKilda2020.xlsm
0
i am trying to create a temp array with the first dimension being set to the ubound of another array, as my temp array will need to have the same number of rows. so here is a sample of my code


Dim AbsenceArray As Variant     'declare my asbence array, this populated by absences for all staff
AbsenceArray = Range("a1").CurrentRegion  'populate my array
ReDim Preserve AbsenceArray(1 To UBound(AbsenceArray, 1), 1 To UBound(AbsenceArray, 2)) 'resize my array and drop header

GetUbound = UBound(AbsenceArray, 1) 'using this to get ubound of absence array and will later use to set unbound of temp array

Dim TempArray(1 To GetUbound, 1 To 2) As Integer    'create my temp array

My code errors on the GetUbound variable, if I put in a static number of course it works with no error. Can someone please advise correct syntax. Thanks
0
Excel worksheet is being used for an on screen board game.
Has a set of cards with instructions that have been inserted and are arrayed.
Objective. Cards need to be stacked in top left corner. And the top card placed at the bottom of the stack when clicked.
ee-example---YachtRacingStKilda2020.xlsm
0
Error MessageI have used this vba macro for a long time without issue - I ran it about 6 weeks ago and it worked fine

now when i try to run it i get an error message on "    objWorkBook1.Close savechanges:=True" that says Compile Error: Method or data member not found

Can any body point me to a solution?


 Sub a01_PST_BACKUP_listAllFolders()
    Dim ns As Outlook.NameSpace
    Dim exp As Explorer
    Dim ff As Outlook.Folder
    
    Dim objExcel As Object
    Dim objworkbook As Object
    Dim objWorkBook1 As Workbook
    
    Dim LastRow As Double

    Set objExcel = CreateObject("Excel.Application")
    objExcel.Visible = True
    Set objWorkBook1 = objExcel.Workbooks.Open("j:\Personal\OutlookData\Transfer Outlook Folders.xlsm")
    Set objWorksheet = objWorkBook1.Worksheets("New Folder List")
    
    objExcel.Sheets("New Folder List").Select
    
    objExcel.Range("a1").Select
    
    objExcel.Selection.End(xlDown).Select
    LastRow = objExcel.ActiveCell.Row
    objExcel.Selection.End(xlUp).Select

    objWorksheet.Columns("A:c").Select
    objWorksheet.Range("B459").Activate
    objExcel.Selection.ClearContents
    
    objWorksheet.Columns("e:j").Select
    objExcel.Selection.ClearContents

    objExcel.Cells(1, 5) = "SubFolder"
    objExcel.Cells(1, 6) = "OrigFolderCount"
    objExcel.Cells(1, 7) = "Status"
    objExcel.Cells(1, 8) = "DestFolder"
    objExcel.Cells(1, 9) = "DestFolderCount"
    objExcel.Cells(1, 10) = "FileDateTime"

    

Open in new window

0
Need to determine if a new quarter has started and check another table for validation

I have a form with a dropdown of names.
After i choose a name i need to perform a Date/quarter calculation.
and compare a value in another table.

quarter_table
fields:
id-autonumber
associate_name - text
q1 - text default  =  no
q2 - text default  =  no
q3 - text default  =  no
q4   - text default  =  no

So after a name has been chosen
What I need:
I need a function to check the Current date(todays date)  and tell me the current quarter, q1,q2,q3,q4

If it is say "april 6th 2020"...the value to return would be "Q2"
Next:
so then i need to check the table "quarter_table" for that person. Look at the Column q2 and see if the entry is  "NO"
if it is
need a message box to display  "q2 = no"


I have a textbox on the form to tell me what
  quarter it is:
Private Sub Text97_GotFocus()
Dim str As String
str = Format(Now, "q")

With Me.Text97
.Locked = False
If str = "1" Then
     Me.Text97.Text = "Q1"
  End If  

If str = "2" Then
     Me.Text97.Text = "Q2"
  End If

If str = "3" Then
     Me.Text97.Text = "Q3"
  End If

If str = "4" Then
     Me.Text97.Text = "Q4"
  End If



.Locked = True
End With
End Sub




Thanks
fordraiders
0
Hello experts,

I use add-in for PowerPoint and Excel.
I proceed like this:

For ppt:
Save my add-in (.pptm file) with .ppam extension at %UserProfile%\AppData\Roaming\Microsoft\AddIns and load it through Files=>Option

For Excel:
Save my add-in (.xlsm file) with xlam extension at %UserProfile%\AppData\Roaming\Microsoft\AddIns and load it through Files=>Option

I don't know how to proceed for Word:

I have my add-in  (.docm) but I don't know which extension should I use to save it at: %UserProfile%\AppData\Roaming\Microsoft\AddIns.

Thank you for your help.
0
Have a list of numbers (column A) and want to cycle through the list and add the number (from column A) against the number of rows down the worksheet that appear in column B using VBA... any ideas?

In the attached file i've described what the output should be for the macro in VBA.

Sheet1 is the setup of how many records should be listed against each
Sheet2 is the output with how it should look like at the end.

Sample.xlsm
0
Tying to run vba code sequence in Outlook to update contacts records based on sent ".to" email address it stalls on contacts with a "." in the first part (e.g. xxx.zzz@test.com) on this code line:

                        Set olObject = ContFldr.Items.Find("[Email1Address] = " & .To)

See attached image for the error message

Full code section is

Sub eBlastUpdateContact02User2BasedonEmailSentData()

    Dim mai As MailItem
    Dim UpdtCount As Integer, UpdtCount1 As Integer
    
    Dim oOlApp As Outlook.Application
    Dim objNmSpc As NameSpace
    Dim ofldr As Object
    Dim ContFldr As Object
    Dim UpdateUserFieldYN As Integer
    Dim ClearExistingUser2ContentYN As Integer
    
    Dim olObject As Object
    Dim olContact As Outlook.ContactItem
    
    Dim propertyAccessor As Outlook.propertyAccessor, SentDate As Date
    
    Dim BodyUpdate As Integer
            
    Set oOlApp = Outlook.Application
    Set objNmSpc = oOlApp.GetNamespace("MAPI")
    
    MsgBox "Select Email Folder - Sent Emails"
    Set ofldr = objNmSpc.PickFolder
    
    MsgBox "Select Contacts Folder"
    Set ContFldr = objNmSpc.PickFolder

    MsgBox "Email Folder for Sent Emails - " & ofldr.FolderPath & vbNewLine & ofldr & vbNewLine & "Contacts - " & ContFldr.FolderPath & vbNewLine & ContFldr
    
    BodyUpdate = MsgBox("Do You Want to Update the Contact Body?", vbYesNo) '2020-04-05
    
    UpdateUserFieldYN = MsgBox("This Process Upadates User2 Field - Do You Want to 

Open in new window

0
Hello experts,

I am trying to find a solution to the following problem:

I have a lot files which use a lot of styles but they are related to different fonts. I would like to find a way to align all fonts in a swiftly and avoid this process manually.

The idea is the following: Set up a VBA procedure to align all the styles in active document by putting as variable the font name Ex: Arial and align all the styles with this font.

If you have questions, please contact me.

Thank you for your help.
0
Hi

What Excel VBA code would I use to check if a column exists. For instance "ÄB" would return true
and "78A" would return false
Thanks
0
I need to extract all instances of numbers in a given string. I have posted a few sample strings in the attached excel file with the expected results for the first string next to a command button.

Can someone provide VBA code which will extract the numbers as listed and also provide the location of each number within the string.
NumericExtractor.xlsm
0
I have MS Access Code and I want the Option to stop it running if a certain condition is met.

The Parent Function calls a sub routine to do the check, which I can stop but I can't stop the Parent function
Then  I tried setting a variable within the sub routine and pass it back to the Parent function, with an If Check= stop then end, but I can pass the baribal back

what is the best way to stop ALL VBA routine (from a form)  running if a condition is met?

------------part of master Function---------------------------------------------------
Dim srtEndFunction As String

    srtEndFunction = "Proceede"
    Call CheckNumberOfProjectSelected
   
    If srtEndFunction = "STOP" Then
End Function
End IF





------Sub Routine----------------------------
Public Function CheckNumberOfProjectSelected()
'Check that the only one project has been selected in table Lookup SUS Details
   Dim strSQL As String
   Dim rs As DAO.Recordset
   Dim StrCountOfCurrent As String
   Dim response As VbMsgBoxResult
   
   strSQL = "SELECT Count([Lookup SUS Details].Current) AS CountOfCurrent FROM [Lookup SUS Details] WHERE ((([Lookup SUS Details].Current)=True))"
   
  Debug.Print strSQL

   Set rs = CurrentDb.OpenRecordset(strSQL)
   StrCountOfCurrent = rs![CountOfCurrent]
   
   If StrCountOfCurrent > 1 Then
   response = MsgBox("You have selected more them one project, Continue?", vbYesNo)
          If response = vbNo Then
            srtEndFunction = "STOP"…
0
Hello experts,

I am struggling with connectors and shapes and I would like to have some thoughts.

I have the following attached document.

I am trying to connect orange with gray box through the gray connector line. Normally the green point should be displayed however I tried with ctrl and shift keys and moving the mouse accordingly and it doesn't work. This process is not straightforward and I would like to know if there is a way to set up a VBA procedure to cover this need. The idea will be select the two shapes and automatically add a line connector. Connector format doesn't matter for the moment.
20200403_152537-screenshot.png
If you have questions, please contact me.
Thank you for your help.
ConnectorsShapes.docx
0
How can I return the name of a range I have selected? I don't want an intersect statement to take place if I selected an entire table, but I do want it to execute if I select either a cell or a two column range. I tried just using typename(selection) I was hoping it would return 'table' as a value, but of course it recognises a table as a range. So I want to be able to check  

if the range I have selected is 'masterprtab' then ……...

if
0
Hi

What Excel VBA code would use to find the 4th instance of the word "CLOSING" using the FIND function and return the row address?
The instance changes so I need to sometimes find the 5th or 6th instance.

Thanks
0
Hi

What Excel VBA code would use to find a partial match of a word "AC223" using the FIND function and return the row number and column number of the cell found?
0
Folks,
Hoping all are virus free and remains so.
This question is regard PivotTables.
Below you see the results of a Pivot query:
Changing label names
Is there a way using VBA that one can have labels automatically changed. For example, if I elect to show by rows, County, PivotTable returns Row Labels. If I am interest in the total sales, PitvotTable returns SumofSales. In the above example I manually changed the name in the Formula bar.

My objective would be to have a message box appear that would allow me to change a label if I choose.
0
I have a table with about 1500 bi-weekly records and a requirement to determine if the repeat occurrence will be every odd week or every even week based on the start date.

How do I do that using Access vba?
0
deleting a space in html  for email in vba outlook

mybody4 = "<p style='font-size:18pt; font-family:calibri;'>Skus unable to escalate.<p>"
mybody4 = mybody4 & "<p style='font-size:18pt; font-family:calibri;'>Please Review.</p>"

this keeps creating a line between the 2 statements:  .i.e.
Skus unable to escalate

Please Review

Need:
Skus unable to escalate
Please Review

Thanks
fordraiders
0

VBA

12K

Solutions

4K

Contributors

Visual Basic for Applications (VBA) enables building user-defined functions (UDFs), automating processes and accessing Windows API and other low-level functionality through dynamic-link libraries (DLLs). VBA is closely related to Visual Basic and uses the Visual Basic Runtime Library, but it can normally only run code within a host application rather than as a standalone program. It can, however, be used to control one application from another via OLE Automation. VBA is built into most Microsoft Office applications.