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.

Hi
In the following code the line     Set xlwb = xlAp.Workbooks.Open(strPath) is
causing issues. The code just seems to hang. I thought the error handler code
would have picked up any issues but it didn't. Can I add any further code or change it
to run more smoothly?
Thanks

Sub oCaller()

    Dim oSamePath As String: oSamePath = ActiveWorkbook.Path
    Dim strPath As String: strPath = oSamePath & "\" & "Freitan Props - TB - Feb 2020.XLSX"
    Dim strWorksheet As String: strWorksheet = "General Ledger Trial Balance"
    Dim oRowHeader As String: oRowHeader = "7050.00.00"
    Dim oColumnHeader As String: oColumnHeader = "CLOSING"
    Dim oRowHeaderColumnNumber As Integer: oRowHeaderColumnNumber = 6
    Dim oColumnHeaderRowNumber As Integer: oColumnHeaderRowNumber = 1
    Dim oValue As String
   
    oValue = GetIntersectValue(strPath, strWorksheet, oRowHeader, oColumnHeader, oRowHeaderColumnNumber, oColumnHeaderRowNumber)
   
    MsgBox oValue

End Sub


Function GetIntersectValue(strPath As String, strWorksheet As String, oRowHeader As String, oColumnHeader As String, _
Optional oRowHeaderColumnNumber As Integer = 1, Optional oColumnHeaderRowNumber As Integer = 1)

    On Error GoTo GetIntersectValue_error
   
    Debug.Print strPath

    Dim xlAp As Excel.Application
    Dim xlwb As Excel.Workbook
    Dim xlws As Excel.Worksheet
    Dim lngCol As Long
    Dim lngRow As Long
    Dim oNotFoundError As String: oNotFoundError = ""
   
 …
0
Hi

I have to build Excel VBA code in an Excel spreadsheet that looks in another closed Excel file and finds the value at the intersection point between  the word " Sundries" which appears on a random row in column A and the word "Household" which appears in a random column in row 1.

What Excel VBA  code would I use to do this?

Thanks
0
Hi
I am using the following Excel VBA code to pull a value from a cell in a closed workbook.
How would I build one function that can be used in each cell to achieve the same thing?
Thanks


Sub oMain()


    Dim oSamePath As String: oSamePath = ActiveWorkbook.Path

    Call GetValuesFromAClosedWorkbook("G27", oSamePath, "Freitan Props - TB - Feb 2020.XLSX", _
            "General Ledger Trial Balance", "H35", False)
           

End Sub

Sub GetValuesFromAClosedWorkbook(ByVal oDestinationCellRange As String, ByVal oSourceFilePath As String, _
            ByVal oSourceFileName As String, ByVal oSourceSheetName, ByVal oSourceCellRange As String, ByVal blnConvertToValue As Boolean)
           
    Dim oFunction As String
           
    With ActiveSheet.Range(oDestinationCellRange)
        'Assigning the array formula to the specified range
        '.FormulaArray = "='" & oSourceFilePath & "\[" & oSourceFileName & "]" & oSourceSheetName & "'!" & cellRange
        oFunction = "='[" & oSourceFileName & "]" & oSourceSheetName & "'!" & oSourceCellRange
        Debug.Print oFunction
        .FormulaArray = oFunction
        'Removing formula from the cell and pasting the values in the cell
        If blnConvertToValue = True Then
            .Value = .Value 'Only activate this line if you want to convert the cell value
        End If
     
    End With

End Sub
0
Hi

I want to automate the calculation of balance sheet numbers in one workbook from another workbook that is sent every month. If I do it manually I would look for account numbers or words in the source document and add these together to get the number in the destination document.

Here is an example of just one formula ='[Freight Props - TB - Feb 2020.XLSX]General Ledger Trial Balance'!$H$30+'[Freight Props - TB - Feb 2020.XLSX]General Ledger Trial Balance'!$H$31

I was thinking of putting the source file name in one cell of the destination file and then using this in a the above formula. Then when the new source file is received just updating this. So for instance could I put "Freight Props - TB - Feb 2020.XLSX" in cell A2 and use that cell reference in the formula above?

Thanks
0
The following VBA solution from this forum has been working great. I just need to add the following criteria to stop the calculation from happening on blank rows:

If Column A = "" then Column J (Expiry Issue) = ""

The existing code is below. Additionally, I have attached a sample Excel file as well as a screen capture depicting what I am looking for.

Function expiryIssue(rng As Range) As String
Application.Volatile
Dim dte1 As Range
Dim dte2 As Range
Dim status As String
Set dte1 = rng.Cells(1, 1)
Set dte2 = rng.Cells(1, 2)
status = rng.Cells(1, 3)
Select Case Cells(rng.Row, "A")
    Case "AIP_ENR", "AIP_AD", "AIP_GEN"
        expiryIssue = ""
        Exit Function
End Select
If status <> "Expired" And status <> "Cancelled" And status <> "Replaced" Then
' If there is no Proposed or Approved expiry date
    If dte2 = "" And dte1 = "" Then
        expiryIssue = "Missing expiry dates"
    Else
    'If there is no Approved Expiry date and the Proposed Expiry date is within 60 days of todays date
        If dte2 = "" Then
            If dte1 < Date + 60 Then expiryIssue = "Review proposed expiry date"
        Else
        'If the Approved Expiry date is older than today's date
            If dte1 = "" Then
                If dte2 < Date Then expiryIssue = "Issue"
            Else
                If dte2 < Date Then expiryIssue = "Issue"
            End If
        End If
    End If
End If
End Function

Open in new window


Thanks!
Andrea
EE_Expiry_Add_Criteria_Blank_Rows.xlsm
Additional_criteria_Mar29.png
0
Hello experts,

The following procedure allows me to insert date in active slide.

I would like to insert date + time like this 29/03/2020 14:22:26

Sub Insert_Date()
    Dim oSld As Slide
    Dim oSh As Shape
    On Error Resume Next ' add your own error handling
    Set oSld = ActiveWindow.View.Slide
    Set oTextRange = oSld.Shapes.AddTextbox(msoTextOrientationHorizontal, _
    515, 0, 250, 400).TextFrame.TextRange
        With oTextRange
            .Font.Color = RGB(255, 0, 0)
            .Text = "Update date: "
            .InsertDateTime ppDateTimeddmmyy, True
        End With
End Sub

Open in new window


Thank you in advance for your help.
0
Experts,

I need VBA code to shade cells purple.
The condition is:
If column E = "Company A" or "Company B" then shade the cells in Column  K purple

How can I do that?
The conditional formatting does not work in this file.  
I think there could be some corruption so I want to test the formatting through VBA

Thank you
0
VBA variable not responding as expected.  Screen shot shows that the value of the form control is 202. GWT is a Variant type. Value of GWT is shown as empty. What do I need to do to get GWT to take on the value of 202?
ScreenShot.pdf
0
I am trying to paste this formula into a cell.

Cells(2, C).Formula = "=if($ES!RC[223]<>0,1,0)"

I get the following error.

Run-time error '1004':
Application-defined or object-defined error
0
I need to loop through a folder of excel files and delete the drawing objects  on specified sheets within each workbook..  I have found the following code to delete
shapes on an active worksheet,

Sub DeleteShapes()
Dim Shp As Shape
For Each Shp In ActiveSheet.Shapes
Shp.Delete
Next Shp
End Sub

but I need to loop through an entire directory of excel files and delete the shapes on two specified named tabs. Each  file has the same two named tabs. Is there a way to  automate this process? I cannot get the workbook open Method to work without an error.
Thanks!
0
I have a spreadsheet where I have multiple rows of different data where I would like to consolidate and summarize on a single line for each ID.  It would be great to have some sort of macro that can take the data from the source tab and generate the data in the output tab (see attached spreadsheet).
ee_help.xlsx
0
I am trying to compare two separate sheets in Excel.  The problem is, each row does not match to the adjacent row.  I want to select a row and compare it to another row displaying what is missing in in either sheet.
0
Fix Win10 VBA Excel 365 loop / variable logic for conditional format.
If the row is a Total row and either (current month and current %, prior month and prior %, current ytd and current ytd%)  are higher than standard, highlight entire row
In test example line 34 should highlight, but none other

 I tried a few things with the conditional formatting variables and this compiles, but something is not working.
previous versions have highlighted every total row and the below one does not highlight any.
lastrow appears working, logic for is it is a total line  appears working.
cr (current row is probably working

Sub ConFormat()

Dim LastRow As Double
Dim myCell As Range

Dim cr As Long
' sv - startvar  sp startperc
Dim sv As Range
Dim sp As Range
' Set sv = Range("F2")
' Set sp = Range("G2")
Set sv = Sheets("Chk").Range("$F$2")
Set sp = Sheets("Chk").Range("$G$2")
cr = ActiveCell.Row
LastRow = Cells(Rows.Count, 3).End(xlUp).Row

For Each myCell In Range("C11:C" & LastRow)
    If Left(myCell.Value, 5) = "Total" Then
'   If OR(AND(ABS(F & cr)>sv,ABS(G & cr)>sp), AND(ABS(J & cr)>sv,ABS(K & cr)>sp), AND(ABS(O & cr)>sv,ABS(P & cr)>sp)) Then
' If (Abs(F & cr) > sv And Abs(G & cr) > sp) Or (Abs(J & cr) > sv And Abs(K & cr) > sp) Or (Abs(O & cr) > sv And Abs(P & cr) > sp) Then
     
      myCell.EntireRow.Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
 "=OR(AND(ABS(F & cr)>sv,ABS(G & cr)>sp), AND(ABS(J & cr)>sv,ABS(K & …
0
Hi EE

I’ve got four digits which I want to put in order so that I can compare them with other sets of four digits to see if they are unique.  For example, 2384 and 3842 once put in order both give 2348 and, under my rationale, they’d be considered not unique.

Any ideas?
Many thanks.
Ben
0
After running a macro to query a database that changes daily, I get two worksheets with formatted reports that may randomly vary between 10 and 15 rows each day.  

I would like to copy the rows from Sheet1, and paste it below the last row of data on Sheet2, leaving a blank row between the two reports.  I would add this code at the end of the macro to generate the merged report.
Example-of-Merged-Reports.xlsx
0
Hello Experts,

I am looking for an excel VBA or add-in to build a decision tree to be use in MS office apps.

Example:

20200326_140714-screenshot.png
Could you please let me know your thoughts.

Thank you for your help.
0
Is it possible to Trim the first 4 characters & the second last from the Json string below, the idea here is to remain with pure json, so that if I fail to iterate it , then I can have it printed and posted to the table manually.(Characters not required are  ]    j  and 4c)
Below is the Ms Access VBA code that takes it to text file , but not fully cleaned up.

Text file Export VBA

n = FreeFile()
    Open "C:\Users\chris.hankwembo\Desktop\Leader\test.txt" For Output As #n
    Print #n, strData
    Close #n

Open in new window

Json String

 ]    j{
   "PosVendor": "Nector Prime Accounting Solutions",
   "PosSoftwareVersion": "2.0.0.1",
   "PosModel": "Cap-2017",
   "PosSerialNumber": "100100001829",
   "IssueTime": "20200326115321",
   "TransactionType": 0,
   "PaymentMode": 0,
   "SaleType": 0,
   "LocalPurchaseOrder": "",
   "Cashier": "Admin Manager",
   "BuyerTPIN": "",
   "BuyerName": "",
   "BuyerTaxAccountName": "",
   "BuyerAddress": "",
   "BuyerTel": "",
   "OriginalInvoiceCode": "",
   "OriginalInvoiceNumber": "",
   "Memo": "",
   "Items": [
      {
         "ItemId": 1,
         "Description": "Cleaning Materials",
         "BarCode": 19,
         "Quantity": 1,
         "UnitPrice": 56,
         "Discount": 0,
         "TaxLabels": [
            "A"
         ],
         "TotalAmount": 64.96,
         "IsTaxInclusive": true,
         "RRP": 0
      }
   ]
}4c

Open in new window

0
Hello experts,

The following vba procedure allows me to resize all objects in selected.

Sub Resize_All_Objects()
    Dim w As Double
    Dim h As Double
    Dim obj As Shape

    w = 0
    h = 0

    ' Loop through all objects selected to assign the biggest width and height to w and h
    For i = 1 To ActiveWindow.Selection.ShapeRange.Count
        Set obj = ActiveWindow.Selection.ShapeRange(i)
        If obj.Width > w Then
            w = obj.Width
        End If

        If obj.Height > h Then
            h = obj.Height
        End If
    Next

    ' Loop through all objects selected to resize them if their height or width is smaller than h/w
    For i = 1 To ActiveWindow.Selection.ShapeRange.Count
        Set obj = ActiveWindow.Selection.ShapeRange(i)
        If obj.Width < w Then
            obj.Width = w
        End If

        If obj.Height < h Then
            obj.Height = h
        End If
    Next
End Sub

Open in new window

I would like to add the following control:

-If objects are not selected show a msgbox: "Unable to proceed as objects haven't been selected" and exit sub.
Thank you for your help.
0
Hi,
I have 2 textboxes in main form.

what i want is:

Every time i write in textbox 1, I want textbox 2 to get a NULL value and vice versa.
The action I did is via the IF command, only the problem is that textbox 2 is getting the value NULL, but it doesnt displayed in the form (not refreshed).
How can I refresh textbox 2 without saving to form.
0
display a prior month value in a query for a field.
In  this  Table:   dbo_QCS_CRS_SCORE
Example data:
JANUARY =  33.4
FEBRUARY =  98.2
MARCH  =    96.3


I have the fields JANUARY TO DECEMBER AS FIELD NAMES. IN "dbo_QCS_CRS_SCORE"
i WOULD LIKE TO ADD THIS TO THE QUERY BELOW AND SHOW THE  PRIOR MONTH SCORE.

so say this is March I need to display February field.
When April 1st is here. I need to display March field ?


SELECT [EMPLOYEE_FIRST_NAME] & " " & [EMPLOYEE_LAST_NAME] AS NAME, QCS_CRS_EMPLOYEE_DIRECTORY.user_id, QCS_CRS_EMPLOYEE_DIRECTORY.EMPLOYEE_STATUS, dbo_QCS_CRS_SCORE.YTD_AVG
FROM QCS_CRS_EMPLOYEE_DIRECTORY INNER JOIN dbo_QCS_CRS_SCORE ON QCS_CRS_EMPLOYEE_DIRECTORY.user_id = dbo_QCS_CRS_SCORE.RACFID
WHERE (((QCS_CRS_EMPLOYEE_DIRECTORY.TITLE_DESCRIPTION) In ('On-Site Specialist','Desktop Specialist','Reference Analyst')))
ORDER BY [EMPLOYEE_FIRST_NAME] & " " & [EMPLOYEE_LAST_NAME];

Open in new window



Thanks
fordraiders
0
I have a table called:
Rebate_Qualifier
3 fields:
Rebate_ID      Entity_Value      Qualifier_ID

"Entity_Value" will always have a value in the field.

I have 2 variables    rb   and   ent

rb = SLS-000118-MAIN-A1-5-R1
ent = 5

The Rebate_Id is null
Qualifier_ID is null

Table example below:
Rebate_ID	Entity_Value	Qualifier_ID
	                AABAA	
	                AABAA	
	                AABAA	
	                AABAA	

Open in new window


What I need:
I need to update the Rebate_Id field with  variable  rb
I need to update the Qualifier_ID field with  variable  ent


Thanks
fordraiders
0
I have a worksheet that runs a macro to copy the data from one sheet ("WAV_Activity_Recap") to another ("Impact") if the values in column E + F do not exist in the WAV_Activity_Recap sheet. All works fine. My issue is I only want to copy the highlighted columns on the WAV_Activity_Recap worksheet to the Impact sheet (I do not need the extra columns on the Impact sheet).

Again, the macro works fine for copying if all the columns counts are the same.

Suggestions?
ImpactXfer.xlsm
0
Excel 365 Windows 10 VBA Conditional formatting
PLTest.xlsx is small sample with data values changed
Corporate monthly #s  tab usually < 1000 rows
place 10000 in F2 10% in G2
format each qualifying row yellow from row2 to last row
Part 1  Is it a total line?     If Left(c2,5) = "TOTAL"  
Part 2 Is it an account line?  isnumber(b2) Account
Macro would run with these default numbers
I would like for the user to be able to change numbers and if necessary rerun the macro

Sub CF_Var()
'
' Macro1 Macro
'
    Dim Lastrow As String
   Lastrow = CStr(wksht.Cells(2, "C").End(xlDown).Row)
   
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "10000"
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "0.1"
    Range("G2").Select
    Selection.NumberFormat = "0.00%"
    With Selection.Font
        .Name = "Century Gothic"
        .FontStyle = "Bold"
        .Size = 14
    End With
    Range("F2").Select
    With Selection.Font
        .Name = "Century Gothic"
        .FontStyle = "Bold"
        .Size = 14
     End With
     'IF left(c27,5) = "Total") start with c2 and check to last row.
'NEED LOGIC HERE to check all rows for TOTAL  
'Version TWO check if column B is a number
  Rows("12:12").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=OR(AND(ABS($F27)>$F$2,ABS($G27)>$G$2),AND(ABS($J27)>$F$2,ABS($K27)>$G$2),AND(ABS($O27)>$F$2,ABS($P27)>$G$2))"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    

Open in new window

0
Hi,

Would like to know how to check whether an Excel workbook is currently opened or not by using Excel VBA?  I'm now using Office 2013.  Thanks

Cheers
Stanley
0
adding a new number sequence to an existing alphanumeric sequence.

I have a dropdown with alphanumeric sequence that either ends in  R1 OR R2 OR R3  OR R4  etc..

and/or  also    I1  , I2 , I3 , I4 etc...

SLS-00612-MAIN-I1
or
SLS-0022-MAIN-R2

What I need:

When i press to save a record i need to automatically come up with the next last 2 alphacharacters in the sequence.

i.e.
So i make a choice from my combo box and the selection is
SLS-023-MAINROOM-R2

The new number is going to be :
SLS-023-MAINROOM-R3

i.e.
So i make a choice from my combo box and the selection is
SLS-006627-MAIN-I1

The new number is going to be :
SLS-006627-MAIN-I2

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.