Expiring Today—Celebrate National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x

VBA

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.

Share tech news, updates, or what's on your mind.

Sign up to Post

Hello experts,

Can anyone help me by providing the list of companies in aerospace industry, in an excel file, with a map chart included?

Thank you!
0
Free Tool: IP Lookup
LVL 10
Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

I am trying to get the function of Application.SumIf() and Application.CountIf() for an internal VBA array defined as Variant.

It is fairly easy to achieve if the criteria Crit in the (non-working) Application.CountIf(tmpArr, Crit) is just supposed to be Equal to the values in the array, but I need Crit to be able to contain criterias like >10, <5 and ideally even wildcards.

Below is a code snippet showing what I have tried for CountIf() , the error it produces and also how I hoped it would work.

Sub CountIfTest()
Dim tmpArr As Variant, Crit As String, tmp As Variant, i As Long
    Crit = InputBox("Criteria", , "<6")
    tmpArr = Array(5, 3, 12, 4, 0, 4, 3, 2, 1)
        
'    MsgBox Application.CountIf(tmpArr, Crit) 'Gives error "Object required" since tmpArr is not a Worksheet.Range()
    For Each tmp In tmpArr
        If tmp Like Crit Then i = i + 1         '"Like" doesn't work, but "If tmp = Crit" works
    Next tmp
    MsgBox "Like test " & i
    MsgBox "Filter test " & UBound(Filter(tmpArr, Crit, True, 0)) + 1                   'Works for Equal, but not for < or > or wildcards
    MsgBox "Match test " & Application.Count(Application.Match(tmpArr, Array(Crit), 0)) 'Works for Equal, but not for < or > or wildcards
End Sub

Open in new window


Any creative ideas?

Thanks,
Jörgen
1
Hi Experts,

Any one have link or excel template which generate tickets for Musical Housie tickets via excel, i have one file (Downloaded from online source ) which generate numerical housie tickets but i need excel which populate musical Housie tickets (Songs Housie Tickets) my song list consist of 89 Songs, i don't need same as housie tickets - per column is one song list (one musical housie ticket).

See attached file.
bingo-housie-ticket-generator-excel-.xls
0
I have recently created a quotation tool which opens up into outlook when the quote is built as a screenshot to send to a customer. I have tested it on my system and it works perfectly, yet I have sent it to a colleague who uses windows 10 (im on 8) and Office 2016 (im on 2013) and it does not work. It just says the location inst available. Please can someone help me with this. I have attached the excel document created.
Quotation-test.xlsm
0
I am working on a project which is Excel based but part of which links to another internal system, a Purchase Order creation platform.

I want to be able to open the PO Platform from the Excel sheet, ideally without going to the Intranet home page first.

Our Intranet home page has a button which links to the PO Platform and I can copy the link from it.

When I use that as a hyperlink in Excel it does not behave the same as when clicking it direct from the Intranet.

Using the link on the Intranet just takes you to the PO platform with single sign on authentication whereas using the hyperlink in Excel shows an error saying user hasn't logged off and then goes to the login window for the platform.  I have spoken to our IT department and apparently it is to do with multiple logins for the PO platform being disabled and we do not want to re-enable it; they have tried in the past and it caused other issues.

So, I am thinking I can maybe set a macro that runs when the hyperlink is clicked. The macro would navigate to the Intranet home screen and "click" the button. The button is stored within a table on the home screen and has a specific jpg as a symbol.

Can this be done?

Thanks
Rob Henson
0
eThe below code is meant to split row data that contains a special character "/" within the cell data for example "SEL/EHL" and populate single value into the row below by having row only for "SEL" and a duplicated row with the cell now with the "EHL" value and to remove the "/" from the metadata that was split.

However the code below for "&" works fine but the above fails to run and generates a run time 9 error message "Subscript out of range" message.

Can any of my peers advise why its happening on this "/" piece of code and not the "&" part of the code even though they are meant to be doing the same thing.

Option Explicit

Sub clean_pos_data()
    Dim rawData() As Variant
    Dim startRange As Range
    Dim v As Long
    Dim i As Long
    Dim j As Long
    Dim x As Long
    Dim cleanData() As Variant
    Dim splitField() As String
    
    With ws_PosSeq
        Set startRange = .Range("a3")
        rawData = startRange.Resize(.UsedRange.Rows.count - startRange.Row, .UsedRange.Columns.count).Value
    End With
    
    For i = 1 To UBound(rawData, 1)
        If InStr(1, rawData(i, 9), "&") > 0 Then
            splitField = Split(CStr(rawData(i, 9)), "&")
            For x = 0 To UBound(splitField)
                 v = v + 1
            Next x
        Else
            If InStr(1, rawData(i, 9), "&") > 0 Then
                splitField = Split(CStr(rawData(i, 9)), "&")
                For x = 0 To UBound(splitField)
                    v = v + 1
             

Open in new window

0
Hi!

I have created 7 templates that I would like to write a Macro for that opens them all in succession for me to manually insert attachments and send.  After trawling a few forums I have cobbled this together however I am now struggling to see what I am missing in order to make this work once assigned to a toolbar button:

Dim template As String

Sub OpenTemplate1()
template = "C:\Users\COsbourn\AppData\Roaming\Microsoft\Templates\Template1.oft"
MakeItem
End Sub

Sub OpenTemplate2()
template = "C:\Users\COsbourn\AppData\Roaming\Microsoft\Templates\Template2.oft"
MakeItem
End Sub

Sub OpenTemplate3()
template = "C:\Users\COsbourn\AppData\Roaming\Microsoft\Templates\Template3.oft"
MakeItem
End Sub

Sub OpenTemplate4()
template = "C:\Users\COsbourn\AppData\Roaming\Microsoft\Templates\Template4.oft"
MakeItem
End Sub

Sub OpenTemplate5()
template = "C:\Users\COsbourn\AppData\Roaming\Microsoft\Templates\Template5.oft"
MakeItem
End Sub

Sub OpenTemplate6()
template = "C:\Users\COsbourn\AppData\Roaming\Microsoft\Templates\Template6.oft"
MakeItem
End Sub

Sub OpenTemplate7()
template = "C:\Users\COsbourn\AppData\Roaming\Microsoft\Templates\Template7.oft"
MakeItem
End Sub

Private Sub MakeItem()
Set newItem = Application.CreateItemFromTemplate(template)
newItem.Display
Set newItem = Nothing
End Sub
0
Dear Respectable Experts,

i need help below code attached function Extract a number from a string value and returns numbers as string i need that it returns number as value or number please help me if it is possible.

Thanks.

Option Explicit

Public Function ExtractNumbers(AValue As Variant) As String
 
  Dim Character As String
  Dim Index As Long
  Dim Result As String
  Dim Value As String
  
  Value = CStr(AValue)
  For Index = 1 To Len(Value)
    Character = Mid(Value, Index, 1)
    If IsNumeric(Character) Then
      Result = Result & Character
    End If
  Next Index

  ExtractNumbers = Result
 
End Function

Open in new window

0
Hi,

I have different form's that i develop on my PC that are according to my screen , when the user open on their screen it shows according to their screens like smaller. I want that the form should fit into different screens. I understand that their is property called "Fit ti Screen" but that's somehow not working. is there a code through which my form should fit into different screen or any other way to address this issue.

Any help/idea would be helpful.

Thanks in advance.
0
Hello,

I have a login form in which user enter Login name and Password. if it is correct the new form open and the login form get close. The docmd for open and close has stop working although it was working before.Code is below for it.
Private Sub Command9_Click()
  If IsNull(Me.txtLogin) Then
        MsgBox "Please Enter Login", vbInformation, "Need ID"
        Me.txtLogin.SetFocus
    ElseIf IsNull(Me.txtPassword) Then
        MsgBox "Please Enter Password", vbInformation, "Need Password"
        Me.txtPassword.SetFocus
    Else
        'If (Nz(DLookup("Password", "tblLogin", "Login = '" & Me.txtLogin.Value & "'"))),"GarbageValue" = Me.txtPassword Then
        If Nz(DLookup("Password", "tblLogin", "UserLogin = '" & Me.txtLogin.Value & "'"), "GarbageEntry") = Me.txtPassword Then
            MsgBox "Welcome" & Space(1) & Me.txtName.Value
            DoCmd.SetWarnings False
            DoCmd.RunSQL "INSERT INTO tblLogHistory([Name],[Login]) Values ('" & Me.txtName & "','" & Me.txtLogin & "')"
            DoCmd.OpenForm "Database"
            DoCmd.Close
        Else
            MsgBox "Incorrect Login or Password"
        End If
    End If
 
    
End Sub

Open in new window


Any idea?

Thank you.
0
New feature and membership benefit!
LVL 10
New feature and membership benefit!

New feature! Upgrade and increase expert visibility of your issues with Priority Questions.

HI I would like to make a simple excel vba to create outlook e-mail. I basically know what to do but I want to know how I can setup "sender".  I would like to set sender different address but not me. would you please help?
0
 
LVL 33

Expert Comment

by:Rob Henson
Hi Luke, you have created a Post rather than raise a question. For better responses from Experts, please use the big blue button at the top of the screen to raise a question.
0
hello,

just need help with the below: (type Mismatch) (me.key is a number)


                Result = Me.Key
       
                    If Result = DLookup("BadgeNumber", "MGSponserLocationBadge", "BadgeNumber=" & Result And Returned = 0) Then
0
I am trying to use a query in VBA Access. There is a criteria that involves a Form. As I understand it I have to use Eval for the DAO to understand the query. I have tried but I keep getting errors.

Below is the query, The Normal SQL VBA query, and what I have tried with Eval.  Thanks for the help.

Query:
SELECT SKUs.SKU, SKUs.SkuNm, Assemblies.Quantity
FROM SKUs INNER JOIN Assemblies ON SKUs.SkuID = Assemblies.ChildSkuID
WHERE (((Assemblies.SkuID)=[Forms]![frmPrintChildrenLabels]![txtParent].[value]));

Open in new window


VBA String:
sSQL = "SELECT SKUs.SKU, SKUs.SkuNm, Assemblies.Quantity" _
& " FROM SKUs INNER JOIN Assemblies ON SKUs.SkuID = Assemblies.ChildSkuID" _
& " WHERE (((Assemblies.SkuID)=[Forms]![frmPrintChildrenLabels]![txtParent].[value]));"

Open in new window


What I have tried but compile error expected end of statement:
VBA String:
sSQL = "SELECT SKUs.SKU, SKUs.SkuNm, Assemblies.Quantity" _
& " FROM SKUs INNER JOIN Assemblies ON SKUs.SkuID = Assemblies.ChildSkuID" _
& " WHERE ((([Assemblies].[SkuID])= Eval("[Forms]![frmPrintChildrenLabels]![txtParent].[value]")));"

Open in new window

0
I use Adobe acrobat XI Pro version 11.0.22 extensively

Have vba code that edits (E) acrobat files adding headers and footers and shrinking file sizes

I understand that Adobe will stop supporting this software on October and they recommend an upgrade

Any advice on the upgrade - how will it affect my code applications?

Examples are

--------------------------------------
Option Compare Database
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As LongPtr) As Long
Private Declare PtrSafe Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As LongPtr, ByVal wFlag As LongPtr) As Long
Private Declare PtrSafe Function GetTopWindow Lib "user32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As LongPtr, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long

Private Const GW_HWNDNEXT = 2
Private Const WM_CLOSE = &H10

Public Function MakeEvenPageCount(ByVal SourcePath As String, ByVal SourceFileName As String, ByVal DestPath As String, ByVal DestFileName As String, ByVal FrstPg As Double, ByVal MaxNoPgs As Double, ByVal FileNo As Double, ByVal DoYouWantToSendToPrinter As Integer, ByVal FontSize As Integer, ByVal 

Open in new window

0
I want to use VBA to populate the cells in a single column with the following formula.

=IF(ISNUMBER(SEARCH("501020",A2)),"x","Y")

where A2 is the starting location of the text that I am searching for "501020", and C2 is the starting location of the result (x or Y).  Each subsequent row would have different text in column A and the appropriate result in column C.  The number of rows in the worksheet will vary ranging up to 500 rows.

I want to duplicate the same results that I get if I copied the above formula in C2, and pasted it down to the last row containing data in column A.
0
In the Part 1 one of this question,  als315 helped me to populate [word] column where each word contained in a sample doc file is recorded separately in a new row.
Index  
For this question, I have a 3-page sample doc file and the word column is handled perfectly via the attached MS Access database. Both DB and the sample DB files are attached. The sample doc file is kept in the DB folder.

Question: In addition to item 1 below, could you possibly help me to read items 2 through 6 from the doc file? I have included the portion of the vba code recording the [Word] column which could be modified to do the rest. I also, have included the database itself in case you are more comfortable doing it by trial and error.
 
1- Word (Already Done).
2- PageNo (Must Have this one)
3- ParagraphNo (Optional, if you can do it)
4- LineNoInThePage (Optional, if you can do it)
5- LineNoInTheParagraph (Optional, if you can do it)
6- ChapterNo (Must Have this one)

Option Compare Database
Dim wrd As Object
Dim iByPass As Integer
Private Sub cmdStart_Click()
Dim objWord As Object
Dim doc As Object
Dim parag As Object
Dim par As Object
Dim sents As Object
Dim sent As Object
Dim wrds As Object
'Dim wrd As Object
Dim path As String
Dim p As Long, w As Long
Dim chapt As Long
Dim s As String
Dim sn As Long
path = 

Open in new window

0
Suddenly, I am getting this error on my db. I have tried to cut off field size, but keeps getting the error. This is a split DB and when I open the BE it opens OK, then I try just to save the table and I am getting the error.
any suggestions?
0
Any idea how to loop through pivot tables applying conditional formatting instead of doing it manually as below.

     ActiveSheet.PivotTables("Test1").PivotSelect "", xData, True
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
        Formula1:="=0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Color = -16776961
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
        Formula1:="=0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Color = -11489280
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
      
         ActiveSheet.PivotTables("Test2").PivotSelect "", xData, True
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
        Formula1:="=0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Color = -16776961
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
        Formula1:="=0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With 

Open in new window

0
Hi,

I have a dashboard created but wish to link some of the information to the data behind it, for example, showing on the front sheet  I wish to look at points 6-11
1) Overdue tickets - done
2) Open Tickets - done
3) Problem tickets - done
4) Completed tickets - done
5) Unassigned tickets - done
6) The person who has been assigned the tasks most often - support on this
7) Which user has reported the most tickets - support on this
8) How to check your ticket (based on the data in the IT Action List) - is there an easy was of a user clicking on a button which then displays the tickets they have reported
9) Top 5 categories reported (number of instances) - chart
10) Top 5 subcategories (number of instances) - chart
11) Open tickets by category - pie chart


Kind regards, Stewart
IT-Log.xlsx
0
Enroll in September's Course of the Month
LVL 10
Enroll in September's Course of the Month

This month’s featured course covers 16 hours of training in installation, management, and deployment of VMware vSphere virtualization environments. It's free for Premium Members, Team Accounts, and Qualified Experts!

It is possible to select range of node using start node and end node.
Below is sample code.

            <w:body>
               <w:p w:rsidR="009F72A0" w:rsidRDefault="00C14A8B" w:rsidP="00D80B27">
                  <w:pPr>
                     <w:pStyle w:val="Heading1" />
                  </w:pPr>
                  <w:bookmarkStart w:id="0" w:name="Page_1" />
                  <w:bookmarkEnd w:id="0" />
                  <w:proofErr w:type="spellStart" />
                  <w:r>
                     <w:t>Microsof</w:t>
                  </w:r>
                  <w:proofErr w:type="spellEnd" />
               </w:p>
               <w:p w:rsidR="00472CBA" w:rsidRDefault="00472CBA" w:rsidP="00472CBA">
                  <w:pPr>
                     <w:spacing w:after="0" />
                  </w:pPr>
               </w:p>
               <w:tbl>
                  <w:tblPr>
                     <w:tblStyle w:val="GridTable5Dark-Accent6" />
                     <w:tblW w:w="0" w:type="auto" />
                     <w:tblLook w:val="04A0" w:firstRow="1" w:lastRow="0" w:firstColumn="1" w:lastColumn="0" w:noHBand="0" w:noVBand="1" />
                  </w:tblPr>
                  <w:tblGrid>
                     <w:gridCol w:w="3116" />
                     <w:gridCol w:w="3117" />
                     <w:gridCol w:w="3117" />
                  </w:tblGrid>
                  <w:tr w:rsidR="00E317D5" w:rsidRPr="00531C77" w:rsidTr="00531C77">
        …
0
Hi, I have a couple of macros which needs to be run automatically every day. However after opening the sheet I need to move the tab and press CNTRL+D to download the file. HOw can do that automations. Please advise

Thanks
Venkatesh.
0
Is it possible to insert image (location map ) in the sheet using VBA if I save all the respective images in a folder with Project code as name.

Say for example if I have DS101.jpg ,DS102.jpg (Project Code column in datasheet) saved in a folder. When I run the macro it fetches the respective image for each project and insert at a specified range (Location) in the template.

Please find the attached excel
CreateMultipleReport_v2a.xlsm
DS101.JPG
0
Hi Experts,

Wondering if there is a way to prevent user from selecting all records in a continuous form and copying into memory?
PS, I can remove the copy/paste menus, however they can still use Cntrl+C to have that contents copied into memory

Thanks in advance.
0
The attached file contains the following code (and includes urls to sources for approach, and for retval = EmptyClipboard():

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Function EmptyClipboard Lib "user32" () As Long

Private Const VK_SNAPSHOT As Byte = 44
Private Const SW_SHOWMAXIMIZED = 3
Private Const VK_LCONTROL As Long = &HA2
Private Const VK_V = &H56
Private Const KEYEVENTF_KEYUP = &H2

Sub SampleShot()
    Dim retval As Variant

    retval = EmptyClipboard()
   
    '~~> Take a snapshot and paste
    Call keybd_event(VK_SNAPSHOT, 0, 0, 0)
    ActiveSheet.Paste
   
    retval = EmptyClipboard()
End Sub

PROBLEM:  
1. The most obvious example is that, if I first select and save some text, and then I call the sub 'SampleShot' above, the text is pasted to the sheet, not the screenshot.  When I run  'SampleShot'  again, then the screenshot image is pasted to the active sheet.

2. I ran  'SampleShot' #1; then changed the layout of file windows on the PC; then I ran  'SampleShot' #2. After  'SampleShot' #2, the screenShot pasted did NOT show the PC screen layout that was created AFTER SampleShot #1, but the PC screen layout that existed BEFORE SampleShot #1.

I've tried to clear the clipboard (before and after screenshot), with no improvement (retval = EmptyClipboard()).

The two problem examples suggest that I am not clearing the …
0
Hi
 have a collection of 12K photos of people (pass type) and I need to try to detect frauds, for example, a person who registered two more times.so I have to show an example photography and know if in the images of my collection there are similar images, one thing that comes directly from the microsoft API:


Face - Find Similar

Given query face's faceId, to search the similar-looking faces from a faceId array or a faceListId. faceId array contains the faces created by Face - Detect, which will expire 24 hours after creation. While "faceListId" is created by Face List - Create a Face List containing persistedFaceIds that will not expire. Depending on the input the returned similar faces list contains faceIds or persistedFaceIds ranked by similarity.

But I do no know how to invoke it.
Can anyone help?
0

VBA

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.