Articles & Videos



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 have a workbook that has VBA code which produces a number of active worksheets by testing for the presence of an entry in cell E10. However, I want to make that determination by the presence of an entry in any cell E10 through E25.

How do I modify the code to accomplish this task?

Function countCellAddress(cellAddress As String) As Double
For Each sht In ThisWorkbook.Sheets
    If sht.Name Like "*-JE-PG-*" Then
        If Len(sht.Range("E10").Value) > 1 Then
            countCellAddress = countCellAddress + 1
        End If
    End If
Next sht

End Function

Workbook is attached.
Free Tool: IP Lookup
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.


Can Excel VBA code designate a specific string of text from within a cell in the same way the =MID() function can extract a string of text?

For example, suppose cell B4 contains the following entry:

        The quick brown fox jumped over the lazy dog.1

And suppose that cells D4 & E4 contain the values 11 & 5 respectively. Then the formula =MID(A2,D4,E4) entered in cell G4 would return the string "brown" as shown here:

How could the same three cell values be captured by VBA and assigned to variables to be used further down in the code?

I want a button on excel to create 2 new pages, but they will just be hidden on the back end then will unhide and add information from the main page when i press the button? Is this possible?  I know there is this code if you do a checkbox:

Private Sub CheckBox1_Click()
    Sheets("Sheet1").Visible = CheckBox1.Value
End Sub

But I am having trouble doing the similar thing with a button instead. Can you help?
VBA: can someone help me with the code on VBA that takes a screenshot of a specific excel spreadsheet on a specific range of cells and attaches it to an email?
I have this solution
need to improve with vba the count

add an countig to the column A in count sheet


also Need add
blank column in sheet PAIR  between CD, DE
Hi all.

I have an Excel macro template that used to pull data from our old SQL Server 2000 and populate the Excel file. It would complete this task within 3 seconds.

Now, we have switched the data source to be our SQL Server 2008 server and now the same Excel file takes close to 35 seconds to populate the Excel file. The only line that has changed is the connection string line:

strConn1 = "DRIVER=SQL Server;SERVER=myOLDServer;UID=me;APP=Microsoft Office 2007;WSID=myWork;DATABASE=myOLDDB;Trusted_Connection=Yes"

Open in new window

strConn1 = "Provider=SQLOLEDB;Data Source=myServer;Initial Catalog=myDB;Integrated Security=SSPI;"

Open in new window

What do I have to do to make it run at the same speed as when it was pulling data from SQL Server 2000? The file only populates about 5-10 lines.

Below is the code for populating the Excel file, the connection string is for the SQL Server 2008 data source
Private Sub PopulateExcel()

Dim cnPubs1 As ADODB.Connection
Set cnPubs1 = New ADODB.Connection

Dim strConn1 As String

strConn1 = "Provider=SQLOLEDB;Data Source=myServer;Initial Catalog=myDB;Integrated Security=SSPI;"

cnPubs1.Open strConn1

Dim rsPubs1 As ADODB.Recordset
Set rsPubs1 = New ADODB.Recordset

With rsPubs1
.ActiveConnection = cnPubs1

    Dim I1
    Dim rng1 As Range
    Set rng1 = Range("B8")
    Dim strSQL1 As String

strSQL1 = "SELECT  PO2_PurchaseOrderEntryLine.ItemNumber, PO2_PurchaseOrderEntryLine.Vendor_AliasItemNumber,  

Open in new window

I have this Summary tab and different supplier tabs that are linked from an access table that I need information pulled from to populate the Summary sheet.  Wanted to see if this is possible to accomplish by entering a number instead of manually entering this information.

Basically if you enter the RFQ number in cell B3 then it would pull it's corresponding row information and populate the specific cells in the summary sheet tab.  See example in the attachment.
How would i upload and retrieve multiple images/files of an individual in a database. for example one can upload five (5)  images/files to MR. A and 3 Images/files to Mr. B and then how would i retrieve the Images/files individually using the Mr. A or Mr. B ID as Key Using Userform in Excel VBA
Hi All i have this excel sheet which have these post codes in column G.

You can see there are drop numbers in column B for them, but if you go down to the bottom there are some which are not slotted in there right position.

how can i slot them in to the correct position in above list.

all i want is all post code starting with there initial 4 character slot in to there corresponding slots and once there are in i can assign them the drop sequence.

Please help

I had this question after viewing Set font smaller and allow box to expand.

Assistance is greatly appreciated.
Free Tool: Subnet Calculator
Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Hi all

 I'm hoping you can offer some advice please!! I have googled as much as I can to get to this point. I have a workbook, and I would like some coding that identifies if a contract is a "Contract - Framework" AND has a status of "Contract Awarded" on the "Procurement Tracker" tab. I would then like the relevant rows that meet this criteria to be copied over to another tab called "Live Contracts" and hidden on the original Procurement Tracker tab.

 This is the formula I have so far that will move the rows that meet the "Contract - Framework" criteria, I would just like to know how to amend it so that the row meets both conditions;

Sub ReqToLive()
 Dim xRg As Range
 Dim xCell As Range
 Dim I As Long
 Dim J As Long
 I = Worksheets("Procurement Tracker").UsedRange.Rows.Count
 J = Worksheets("Live Contracts").UsedRange.Rows.Count
 If J = 1 Then
 If Application.WorksheetFunction.CountA(Worksheets("Live Contracts").UsedRange) = 0 Then J = 0
 End If
 Set xRg = Worksheets("Procurement Tracker").Range("F1:F" & I)
 On Error Resume Next
 Application.ScreenUpdating = False
 For Each xCell In xRg
 If CStr(xCell.Value) = "Contract - Framework" Then
 xCell.EntireRow.Copy Destination:=Worksheets("Live Contracts").Range("A" & J + 1)
 xCell.EntireRow.Hidden = True
 J = J + 1
 End If
 Application.ScreenUpdating = True
 End Sub

Open in new window

Hope that makes sense! Thanks in advance

Is it possible to call a function (in eg Module1) in an Excel cell?
I have an excel sheet. One column has company names and another column has company 1 line description, there is multiple description entries (of different types) for same company. So, company ABC is repeated 10 times in column A with 10 corresponding different descriptions in column B, then company PQR is repeated 16 times in column A with 16 corresponding different descriptions in column B (after company ABC's entry).

Out come needed : Find all the unique words for company ABC from all the description lines corresponding to Company ABC and display count of every unique word for Company ABC ( e.g. "good" : 5 times , "the" :10 times , "big" : 7 times etc). And similarly for company PQR and other companies in the sheet.
Dear macro experts, please help.
I would like the macro to adjust (shrink or increase) row height anywhere in sheet depends of the text in cells. The rows and columns have Merged Cells and Wrapped Text. The text is always in other two rows and in same 11 column from B to L. Column length is static. That two rows need to be same size and the text need to fit.
Hi Experts,

I had this code working fine in a DSN based connection.
Set objRec = CreateObject("ADODB.Recordset")
Set objConn = CreateObject("ADODB.Connection")

objConn.ConnectionString = "Provider=MSDASQL;DSN=PlacementNP;Initial Catalog=PlacementNP;User Id=MyUser;Password=MyPWD"

Open in new window

However now that we changed to a DSN-less connection I can't get it to work, tried the following
Set objRec = CreateObject("ADODB.Recordset")
Set objConn = CreateObject("ADODB.Connection")

objConn.ConnectionString = "ODBC;DRIVER=sql server;Server=tcp:sqlserver1\exp08;Database=PlacementNP;UId=MyUser;PWD=MyPWD;Trusted_Connection=No"

Open in new window

And I get the attached error, when all the credentials are still the same.

Any idea what's wrong here?
I have an Access form that has a combo box (cboField) and a text box (txtField ) the combo box uses a "Value List" to populate from the table fields and the text box the user enters the search criteria with and uses LIKE to allow for partial searches. Hitting enter runs the the search, deleting data values in the text box resets the records to unfiltered. The search works fine except that when the records are filtered I can't edit the filtered records. Below is the code running on both the text box and combo box.

Private Sub cboField_Enter()
Dim oRS As DAO.Recordset, i As Integer
If Me.Form.FilterOn = True Then DoCmd.ShowAllRecords
Set oRS = Me.RecordsetClone
cboField.RowSourceType = "Value List"
cboField.RowSource = ""
For i = 0 To oRS.Fields.Count - 1 'OR 1 To Count
 If oRS.Fields(i).Type = dbText Then cboField.AddItem oRS.Fields(i).Name
 Next i
End Sub

Open in new window

Private Sub txtFilter_Exit(Cancel As Integer)
 Dim sFilter As String, oRS As DAO.Recordset
 If IsNull(cboField) Then
 MsgBox "No Search Item Selected"
 Exit Sub
End If
If IsNull(txtFilter) Then DoCmd.ShowAllRecords
sFilter = cboField & " LIKE '" & txtFilter & "*'"
DoCmd.ApplyFilter , sFilter
Set oRS = Me.RecordsetClone
 If oRS.RecordCount = 0 Then
 MsgBox "No Matches Found"
End If

Open in new window

I have this code which will find matching sets of three numbers (and colour them for ID) across a worksheet. (sample sheet attached 007-quad-ID-query-ee.xls )

Could it be adjusted to find those sets of three numbers which match 5 or more times ?
Code :

Option Explicit

Private Type Sets
    strAddr As String
    strCells As String
    lngColor As Long
End Type

Sub IdentifyDuplicates()

    Dim lngLastRow As Long
    Dim lngLastColumn As Long
    Dim lngRow As Long
    Dim lngCol As Long
    Dim DupeSets() As Sets
    Dim strSet As String
    Dim lngFind As Long
    Dim lngFound As Long
    Dim lngColors()
    Dim lngNextColor As Long

    lngColors = Array(13494512, 11599871, 13626575, 15723724, 15258845, 12178907, 8518399, 11461045, 14667418, 14136257, 10074816, 5369343, 9491089, 14071663, 12683685, 13233150, 11596768, 14541491, 15259071, 15654653, 10668797, 7791807, 12504966, 13674644, 13743867, 8759804, 6146693, 10728776, 12552565, 11963641, vbYellow)
    lngNextColor = 0

    ReDim DupeSets(0)
    lngLastRow = Range("A65536").End(xlUp).Row
    lngLastColumn = Cells.Find("*", SearchOrder:=xlByColumns, LookIn:=xlValues, SearchDirection:=xlPrevious).Column

    For lngRow = 4 To lngLastRow
        If Cells(lngRow, 1) <> "" Then
            For lngCol = 8 To lngLastColumn Step 4
                strSet = Cells(lngRow, lngCol) & "," & Cells(lngRow, lngCol + 1) & "," & Cells(lngRow, lngCol + 2)
I have this code which sorts groups of 6 numbers into all possible sets of 3 (of which there are 20)

Could someone help and alter it so that it sorts 6 numbers into all possible sets of five please ?

Public Sub Triples()
    intNumbers = 6
    Set wsData = ThisWorkbook.Worksheets("Sheet1")
    For rowCurrent = 4 To wsData.Cells(wsData.Rows.Count, 1).End(xlUp).Row
        colOutput = 8
        For i1 = 1 To intNumbers - 2
            For i2 = i1 + 1 To intNumbers - 1
                For i3 = i2 + 1 To intNumbers
                    wsData.Cells(rowCurrent, colOutput).Value = wsData.Cells(rowCurrent, i1).Value
                    wsData.Cells(rowCurrent, colOutput + 1).Value = wsData.Cells(rowCurrent, i2).Value
                    wsData.Cells(rowCurrent, colOutput + 2).Value = wsData.Cells(rowCurrent, i3).Value
                    wsData.Cells(rowCurrent, colOutput + 3).Value = ""
                    colOutput = colOutput + 4
End Sub
I have a scan Operator Database where the scan operator saves details such as the main scan folder for that day, it's subfolders and the files withing those subfolders (All in 1 to many relationships).

On the form f_Batch_Scans, the scan operator fills in some details about that scan batch (Operator name, date, etc) and then clicks on the black command button to insert the Main Batch Scan folder. This folder name is written into t_Batch_Scans. The next step is to click on the next black button "Click here to list the subfolders".

I am trying to add the related subfolders to the subform, however, I cannot get the table to update, and the debug either fails on rst.AddNew or .rst.Update.

I can see the correct values for SubDir exist in the immediate window, but cannot for the life of me get the subfolders table to update...

Attached is the database if you wish to have a look at it.

Thank you for your help with this !

Free Tool: SSL Checker
Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

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 have 20 worksheets with several data sheets (not every sheet), that I need to consolidate to a master file.  Not all worksheets are the same format.  I am saving them all in one folder.  What I need is a macro, to open all the files, copy from each one the data into a newly created mater workbook please.  On the first copy I would like all the sheets headers, but on the subsequent copies I would just want to copy the data starting at a certain row depending on which sheet (eg ignoring repeating headers).  I do also have hidden columns that need copying across and would like it all in paste special values.  Can you please help I am not great with macros...
Hey Guys

Hope you can help
Ive been asked to come with a way to price check invoices against what we have on our purchase order system

I have a report that pulls from our system with the prices that have been entered on there as well as the invoice from the supplier with their prices.

In theory, they should match but we are having some issues

Ive been trying to find a way in which to paste the internal report into Sheet 1 and the invoice into Sheet 2 and on Sheet 1, against the PO references, pull the prices from the invoice on Sheet 2.

I have tried INDEX and MATCHING, LOOK UP and ABS references but the problems I have are two-fold:-

1)      The formatting can change in the way the purchase number is displayed on the invoice – some have the PO012345 and some have just the last five digits. This would mean that the solution would have to search using a wild card plus the unique last five digits across the two sheets.

2)      Not all the invoices are the same in the way in which they are sent therefore, I have been trying to find a way to search the WHOLE sheet and not just a certain column etc, which has proven unsuccessful

I have attached a sample sheet. Sheet 1 has our internal report, Sheet 2 has the supplier invoice.

In column O, I have manually entered what should be the result of the formula / VBA. From this example you can see that O27 and O35 would not match and therefore would flag an anomaly between the two documents.

Ideally if there is anyone…

Need VBA to recursively select all Doc files in the folder and sub folders to split word document based on the section break and save in the same folder to where the master file is located.

I have attached my code and I really dont know whats wrong with that. Please help.
Sub test()
Dim Dbk As Document
Dim Filename As String
Dim Path As String
Dim i As Long
Dim DocNum As Long
Dim docOld As Document
Dim docNew As Document

Path = "\\Test-pc\d\Table Issue\"
Filename = Dir(Path & "*.doc")
 Do While Len(Filename) > 0  'IF NEXT FILE EXISTS THEN
    Set Dbk = Documents.Open(Path & Filename)
Dim DocPath1 As String
Dim DocName As String
    DocPath1 = ActiveDocument.Path
    DocName = Split(ActiveDocument.Name, ".")(0)

    ' Used to set criteria for moving through the document by section.
    Application.Browser.Target = wdBrowseSection

    'A mail merge document ends with a section break next page.
    'Subtracting one from the section count stop error message.
    For i = 1 To Dbk.Sections.Count
        'Select and copy the section text to the clipboard.

        'Create a new document to paste text from clipboard.
        Set docNew = Documents.Add

        ' Removes the break that is copied at the end of the section, if any.
        Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend

Open in new window

I am trying to use this code and it won't work. I want it to search column W for specific keywords that the user can input. If the cell contains the word the code should move to the next cell. If the cell  does not contain the word then it the code should delete the entire row.
-I want the user to be able to enter multiple keywords separating them with a semi colon
-The area I am filtering in Excel comes into excel as a table. The code to find the area I need sorted is as follows
Sheets("Screening").Range("A9").CurrentRegion.Resize(Sheets("screening").Range("A9").CurrentRegion.Rows.Count - 1, 1).Offset(1, 22)

Heres my code:

Sub Filter()

   Dim r As Long
   Dim LastRow As Long
   Dim SearchCriteria As String
   Dim arr() As String
   Dim i As Long
   Dim HideRow As Boolean
   Dim LastColumn As Range
    'Allows user to input the keywords
   SearchCriteria = InputBox("Enter your required Search Criteria" & vbCrLf & _
                             vbCrLf & "[Seperate Search items with a semi-colon ( ; )]")
   If SearchCriteria = "" Then Exit Sub
   'Helps with lag
   Application.ScreenUpdating = False
   'Parses data to find the words input
   arr = Split(SearchCriteria, ";")
   'loop for search
   LastColumn = Sheets("Screening").Range("A9").CurrentRegion.Resize(Sheets("screening").Range("A9").CurrentRegion.Rows.Count - 1, 1).Offset(1, 22)
   LastRow = Sheets("screening").Range("A9").CurrentRegion.Rows.Count
   LastRow = LastRow…
I am attempting to do an Insert Into sql statement in access.  Done as a select statement, it pulls up the expected result, done as an Insert Into, it returns an error "Record Deleted".


Select: (works)
SELECT dbo_tblMonthlyServiceFees.SeqTransactionID, getwinuser() AS Expr1, dbo_tblMonthlyServiceFees.BatchDateTime, dbo_tblAllLoans.SeqLoanNumber, dbo_tblMonthlyServiceFees.GLoanNumber, dbo_tblMonthlyServiceFees.LoanDate, dbo_tblMonthlyServiceFees.PLLoanNumber, "DSF Houston" AS AllocTo, 1 AS RankFeePct, 1 AS AdjfeePct, 0 AS MCredit, "170101  104404" AS OfcAcctCode, dbo_tblMonthlyServiceFees.ServiceFeeAmount, dbo_tblMonthlyServiceFees.ServiceFeeRate, dbo_tblMonthlyServiceFees.FreddieMacServiceFeeRate, dbo_tblMonthlyServiceFees.ReducedServiceFeeRatio, dbo_tblMonthlyServiceFees.ReducedServiceFeeAmount, dbo_tblMonthlyServiceFees.TransactionDate, dbo_tblMonthlyServiceFees.PaymentDueDate, dbo_tblMonthlyServiceFees.PaymentNumber, dbo_tblMonthlyServiceFees.InterestRate, 0 AS ProdCalcFee, 0 AS ProdAdjCalc, dbo_tblMonthlyServiceFees.ServiceFeeAmount, dbo_tblMonthlyServiceFees.ServiceFeeAmount, dbo_tblAllLoans.CreatedByUser, dbo_tblAllLoans.CreatedDate, 1 AS NoFeeSplit, 1 AS NoProdAlloc
FROM dbo_tblMonthlyServiceFees LEFT JOIN dbo_tblAllLoans ON dbo_tblMonthlyServiceFees.PLLoanNumber = dbo_tblAllLoans.PLLoanNumber
WHERE (((dbo_tblMonthlyServiceFees.BatchDateTime)=[Forms]![frmImport]![txtBatchDateTime]) AND ((dbo_tblAllLoans.SeqLoanNumber) Is Null));

Open in new window

Insert: (Returns error)

Open in new window

I need vba script in excel to find an email in my outlook inbox with a particular subject and from a particular person then break up the subject line in order to isolate a numeric value from other text and then input this value into an active spreadsheet into "A1".





Articles & Videos



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.