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

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
[Webinar] Lessons on Recovering from Petya
LVL 10
[Webinar] Lessons on Recovering from Petya

Skyport is working hard to help customers recover from recent attacks, like the Petya worm. This work has brought to light some important lessons. New malware attacks like this can take down your entire environment. Learn from others mistakes on how to prevent Petya like worms.

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
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
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 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
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
New benefit for Premium Members - Upgrade now!
LVL 10
New benefit for Premium Members - Upgrade now!

Ready to get started with anonymous questions today? It's easy! Learn more.

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
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
0
Hi,
I have a datasheet and a template. I need to create around 30 worksheets(in the same workbook) using the data . When I run the macro with 7 sets of data it is working fine (execution time: 3 minutes). But it is hanging if I enter more number of data.

Please find the code I am using:

Option Explicit


Sub PTOTemplateFill()


Dim LastRw As Long, Rw As Long, Cnt As Long
Dim dSht As Worksheet, tSht As Worksheet
Dim MakeBooks As Boolean, SavePath As String


Application.ScreenUpdating = False  'speed up macro execution
Application.DisplayAlerts = False   'no alerts, default answers used



Set dSht = Sheets("Datasheet")           'sheet with data on it starting in row2
Set tSht = Sheets("Project Page Template")       'sheet to copy and fill out

'Option to create separate workbooks
    MakeBooks = MsgBox("Create separate workbooks?" & vbLf & vbLf & _
        "YES = template will be copied to separate workbooks." & vbLf & _
        "NO = template will be copied to sheets within this same workbook", _
            vbYesNo + vbQuestion) = vbYes

If MakeBooks Then   'select a folder for the new workbooks
    MsgBox "Please select a destination for the new workbooks"
    Do
        With Application.FileDialog(msoFileDialogFolderPicker)
            .AllowMultiSelect = False
            .Show
            If .SelectedItems.Count > 0 Then    'a folder was chosen
                SavePath = .SelectedItems(1) & "\"
                Exit Do
         …
0
I am trying to get the vba in a module to sum textboxes in a userform based the combo box.  I've watched several tutorials, but I've only found "sumifs" and that isn't what I need.

SOV-For-Calc.xlsm
0
In the sample file attached on OCEAN tab there is raw data and on DATA tab formulas display values looking at the OCEAN tab and the other tabs on the file.  

I have been trying to copy the formula range B2:AG2 down according to the criteria in A2 cell.  If the value in the A column is 1 for the corresponding range Excel should copy the formula range down. When no value shows in A column it should stop copying down the formulas.  

The formula in column  A goes down to the row number 100,000. As an alternative I did this simply by using IF logic for each formula cell but this is not how I want to achieve this. I don't want to fill up the whole range all the way down to corresponding number of rows on the OCEAN tab.  I tried to come up with a VBA procedure to accomplish that but was not successful.  

I would appreciate if an expert can help me to do this by adding a VBA procedure.

Thank you
EE-Setup-Formulas.xlsx
0
Hi Guys

I built the below query and set it up as a Stored Procedure in SQL 2008, query:

USE [Cosmos]
GO

/****** Object:  StoredProcedure [dbo].[Tour]    Script Date: 9/16/2017 10:28:34 PM ******/

SET ANSI_NULLS ON
GO

SET QUOTED_IDENTIFIER ON
GO

-- =============================================
-- Author:     
-- Create date: 
-- Description:
-- =============================================

ALTER PROCEDURE [dbo].[TourDesk] 
@TourStartDate AS DATETIME, @TourEndDate AS DATETIME

AS
BEGIN
-- SET NOCOUNT ON added to prevent extra result sets from
   SET NOCOUNT ON;
-- Query
SELECT 
	t.sale_no as [Sales Number]
	,t.trans_no as [Transaction Number]
	,t.department as [Department]
	,t.category as [Category]
	,t.item as [Product Name]
	,CAST(t.date_time as DATETIME) as [Date of Sale]
	,t.init_price as [Initial Price]
	,t.quantity as [Quantity]
	,t.disc_amt as [Discount Amount]
	,t.disc_flat as [Discount Flat]
	,t.tax_amount as [Tax Amount]
	,t.extension as [Extension]
	,t.pcsplit_1 as [Profit Center EX GST]
	,SUM(CASE WHEN t.item in ('PJB.EB.AD', 'PJB.CO.CH', 'PJB.EB.CH', 'PJB.EB.FAM', 'PJB.PM.AD', 'PJB.PM.CH', 'PJB.PM.FAM') THEN (t.quantity*(t.init_price*0.7)/1.1)
	WHEN t.item IN ('AQDUCK.FAM', 'AQDUCK.SEN', 'AQDUCK.AD', 'AQDUCK.CH') THEN (t.quantity*(t.init_price*0.7)/1.1)
	WHEN t.item in ('SC.GW.AD', 'SC.GW.CH', 'SC.GW.SEN', 'SC.HOP.AD', 'SC.HOP.CH', 'SC.HOP.SEN', 'SC.NB.AD', 'SC.NB.CH', 'SC.NB.SEN', 'SC.OT.AD', 'SC.OT.CH', 'SC.OT.SEN', 'SC.WW.AD', 'SC.WW.CH', 

Open in new window

0
Trying to extract data from website into excel.
Site is https://www.btcmarkets.net

I am after the exchange markets data.

I have tried the DATA - from web approach by doesnt allow me to get table.

Can anyone help
0
On Demand Webinar: Networking for the Cloud Era
LVL 10
On Demand Webinar: Networking for the Cloud Era

Did you know SD-WANs can improve network connectivity? Check out this webinar to learn how an SD-WAN simplified, one-click tool can help you migrate and manage data in the cloud.

I am using a random String generator for my product SKUs. This is a good generator as it does exactly what I need. I have been using it in a Append query with a dummy and I have been having trouble getting it to give me Unique new Strings.

I have to run the Append query several times and it will say Key Violations several times. Then just like a slot machine Bingo! It hits the spot. How can I get this generator to go through a list before giving me a value?  Such as from my table SKUs Field SKU  SKUs.SKU Thanks for the help.

Option Compare Database
Option Explicit
Public Function StrRandomWithDummy(ByVal Dummy As Variant, ByVal lngLen As Long) As String

On Error GoTo ErrorHandler

'**TO USE IN A QUERY EXAMPLE: "SKU: StrRandomWithDummy([Replace this with any other Field Name used in the Query],11)"
' Create fixed length string of random characters.
' Will generate about 512K per second.
'
' 2002-02-02. Cactus Data ApS, CPH

    Dim StrRnd        As String
    Dim lngN          As Long
    Dim strChar       As String
      
    Randomize
    lngLen = Abs(lngLen)
    ' Create string of zeroes, lngLen long.
    StrRnd = String(lngLen, "0")
    ' Perform hi-speed filling of string with random character string.
    While lngN < lngLen
        strChar = Chr(48 + Rnd * (90 - 48)) '48-57 is the ASCII for 0 through 9 and 90 - 65 is the ASCII for Capital A through Z.
        Select Case strChar
            Case "I", "L", "O", ":", ";", "<", "=", ">", "?", "@" ' Ignore these

Open in new window

0
Hi,

See Attached:

I'm trying to customize this Excel Checklist Template that I obtained from the following link:

http://www.clearlyandsimply.com/clearly_and_simply/2015/01/microsoft-excel-check-list-compilation.html

File Name: 08_check_list_more_columns.xlsm

I'm trying to add more columns between columns D & E without messing up the Percentages.  When inserting extra columns, then checking off the boxes to mark it as complete in the row, the Percentages on the top don't match up with the column check boxes that were just changed, it pushes them to the right one.

When the document is open you can hit "ALT + F11" to open up the VBA Editor.  I've tried to diagnose where I would change the correct entry so that it doesn't mess everything up when I add the extra columns but I can't find it.  I"m not a coder or understand how they created this so please explain in detail.

Please HELP!!!!

Thanks
08_check_list_more_columns.xlsm
0
Is there a way I can include a blank selection in a combobox used to filter a form, to clear the filter?
0
Hello - need assistance with writing a nested IIF statement in a MSACCESS query

Here is what I am trying to do:

If COMPONENT = MED, then I need to look at the difference between REFILLS ALLOWED and REFILLS REMAINING.  If they are equal numbers the result will be START. If they are not equal, then result should be "REFILL"

If COMPONENT IS NOT "MED", then need to look at the difference between REFILLS ALLOWED and REFILLS REMAINING.  If the difference between  REFILLS ALLOWED and REFILLS REMAINING is -1, Then  the result will be START. If the difference is more than 2, then result should be "REFILL".  

Note: REFILLS ALLOWED will always have a bigger number than Refills Remaining.

I tried.... but this does not work....
STATUS: IIf([COMPONENT]= "MED"& [REFILLS_ALLOWED] = [REFILLS_REMAINING], "START",REFILL",IIf([COMPONENT] NOT "MED" & [REFILLS_ALLOWED] = [REFILLS_REMAINING] -1, "START", IIf([COMPONENT] NOT "MED" & [REFILLS_ALLOWED] = [REFILLS_REMAINING] >-2, "REFILL",

EXAMPLE
Component    Refills Allowed         Refills Remaining             Status
   MED                    3                                    3                                START
    SOL                     3                                    2                                START
    MED                   3                                     1                                 REFILL
    MED                   2                                     0                                REFILL…
0
Hi can someone help please?

I have an Access database which contains a table of IP addresses.

I want to add a further column to the table which only contains the 1st three octets of the IP address.

e.g

IP Address            Octet
1.1.1.1                   1.1.1
172.0.1.27             172.0.1
192.168.3.1.2        192.168.3

How can this be done?

Many Thanks

Jay
0
Hellow Experts,

I am making Excel Function which Extract me number from string but its not working kindly Guide me.

Explanation : if A1 = abc123 then i want result =DAS_2(A1) = 123

Regards,

Function DAS_2(n As String)
    Dim r As String

    For i = 1 To Len(n)
        k = Mid(n, i, 1)
        If IsNumber(k) Then
            r = r & k
    Next i

    DAS = r

End Function

Open in new window

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.