Welcome to my Code Section for VBA. Here you will find Code, Subroutines & Functions for VBA. You can read about any updates to this section or follow my work on Facebook. If you have used any of my other work and wish to donate, you can do so on my Donate Page

Use the Quick Search to find an article of choice. You can also Sort the list either ascending or descending by Name, or by the links that have a File available to view or download. You can press Clear to reset the Search:







Core Subroutines

[Back to Search]

Here are my Core Subroutines for Excel using Visual Basic for Applications. Click the Link to open the Code in a separate Window and then Simply Copy & Paste the entire Code or any parts of the Code into a Code Module in Excel. Remember to remove the first line which is the Module reference otherwise you will get the compile error, 'Syntax Error'. You can use the intellisense Drop-down box to view all of the Subroutines and Functions sorted alphabetically after you have copied in the Code. You can also do a CTRL+F to Search in the Browser Window for any particular Subroutine or Function

View Core Subroutines (242 KB)





Disable And Enable A Button Form Control On A Worksheet

[Back to Search]

To Disable & Enable a Button Form Control on a Worksheet download the Workbook below. The Code will Disable the Button in a Worksheet by changing the Font Colour and setting the Macro to a dummy one, so the final look is a Disabled Button

Here is the Code which uses a Form Button called "Button 1":

Option Explicit
 
' /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
' // disable a Command Button in a Worksheet
' /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Public Sub Disable()
    Dim objButton As Button
    Set objButton = ActiveSheet.Buttons("Button 1")
    objButton.Font.ColorIndex = 15
    objButton.Enabled = False
    objButton.OnAction = "LinkedMacroButDoesNothing"
End Sub
 
' /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
' // disable a Command Button in a Worksheet
' /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Public Sub Enable()
    Dim objButton As Button
    Set objButton = ActiveSheet.Buttons("Button 1")
    objButton.Font.ColorIndex = 1
    objButton.Enabled = True
    objButton.OnAction = "LinkedMacro"
End Sub
 
Public Sub LinkedMacroButDoesNothing()
 '
End Sub
 
Public Sub LinkedMacro()
 MsgBox "foobar"
End Sub

Disable & Enable Form Button.xlsm (17.6 KB)





Find Last Row In Column Quickly Using XLDown

[Back to Search]

Here is a quick way to find the Last Row in a Column "A" for the Active Worksheet

MsgBox ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row





Run A Macro On Opening An Excel Workbook

[Back to Search]

Q. How can I automate Code in Excel using VBA?
A. Here are are a couple of methods - if you use both, Method 2 will always fire first, but even closing Excel using Application.Quit will not prevent Method 1 from being executed so pick one or the other
1. Use the Sub auto_open() once in any Code Module:

Sub auto_open()
 MsgBox "foo"
End Sub
 
2. Use the Sub Workbook_Open() once in the ThisWorkbook Code Module:
Private Sub Workbook_Open()
 MsgBox "foobar"
End Sub
 





Output A Range Of Headers With Bold Formatting Using Array

[Back to Search]

Here is a useful way to Output a Range of Headers with Bold Formatting using an Array for the Active Worksheet.

Sub AddingHeadersByArray()

' // add a Header Range from A1:D4, set to Bold & autofit Column widths
With ActiveSheet.Range("A1:D1")
 .Value = Array("Product", "Product Description", "Depot", "Depot Description")
 .Font.Bold = True
 .Cells.EntireColumn.AutoFit
End With

End Sub
 





Create Pair Combinations

[Back to Search]

Here is a Workbook to help you create combinations from a list. For example you may have 3 Shirts, Red, Blue and Yellow and want to derive the 'Pair Combinations' of all of these items ie. 'Red Shirt, Blue Shirt; Red Shirt Yellow Shirt' etc. This Workbook allows you to do just that and includes the options to 'Display repititions ie. 'Red Shirt, Red Shirt' and to 'Allow similar Combinations' ie. 'Red Shirt, Yellow Shirt' and 'Yellow Shirt, Red Shirt' if you want to. To create Pair Combinations you can use the following Workbook:

CreatePairCombos.xlsm (19.9 KB)





Create Treble Combinations

[Back to Search]

To create Treble Combinations in a similar fashion as the Create Pair Combinations you can use the following Workbook:

CreateTrebleCombos.xlsm (18.7 KB)





32 Bit And 64 Bit API Declarations For VBA Developers

[Back to Search]

Here is a list of 32bit & 64bit API Declarations for VBA Developers - simply Copy & Paste them into your Code Modules, change the Private to Public if required:

32bit API Declarations

 
    ' // 32bit API Declarations
    Private Declare Function FindWindow Lib "User32.dll" Alias "FindWindowA" (ByVal lpszClass As String, ByVal lpszWindow As String) As Long
    Private Declare Function MoveWindow Lib "User32.dll" (ByVal HWnd As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
    Private Declare Function GetWindowLong Lib "User32.dll" Alias "GetWindowLongA" (ByVal HWnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function SetWindowLong Lib "User32.dll" Alias "SetWindowLongA" (ByVal HWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function SetLayeredWindowAttributes Lib "User32.dll" (ByVal HWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
    Private Declare Function DrawMenuBar Lib "User32.dll" (ByVal HWnd As Long) As Long
    Private Declare Function GetSystemMetrics Lib "User32.dll" (ByVal nIndex As Long) As Long
    Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
    Private Declare Function ReleaseDC Lib "User32.dll" (ByVal HWnd As Long, ByVal hDC As Long) As Long
    Private Declare Function GetDC Lib "User32.dll" (ByVal HWnd As Long) As Long
    Private Declare Function SetTimer Lib "user32" (ByVal HWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Private Declare Function KillTimer Lib "user32" (ByVal HWnd As Long, ByVal nIDEvent As Long) As Long
    Private Declare Function AddFontResource Lib "gdi32" Alias "AddFontResourceA" (ByVal lpFilename As String) As Long
    Private Declare Function RemoveFontResource Lib "gdi32" Alias "RemoveFontResourceA" (ByVal lpFilename As String) As Long
    Private Declare Function AddFontMemResourceEx Lib "gdi32" (ByVal pbFont As Integer, ByVal cbFont As Integer, ByVal pdv As Integer, ByRef pcFonts As Integer) As Long
 
64bit API Declarations
 
    ' // 64bit API Declarations
    Private Declare PtrSafe Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare PtrSafe Function MoveWindow Lib "User32.dll" (ByVal HWnd As LongPtr, ByVal X As LongPtr, ByVal Y As LongPtr, ByVal nWidth As LongPtr, ByVal nHeight As LongPtr, ByVal bRepaint As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetWindowLong Lib "User32.dll" Alias "GetWindowLongA" (ByVal HWnd As LongPtr, ByVal nIndex As LongPtr) As Long
    Private Declare PtrSafe Function SetWindowLong Lib "User32.dll" Alias "SetWindowLongA" (ByVal HWnd As LongPtr, ByVal nIndex As LongPtr, ByVal dwNewLongPtr As LongPtr) As LongPtr
    Private Declare PtrSafe Function SetLayeredWindowAttributes Lib "User32.dll" (ByVal HWnd As LongPtr, ByVal crKey As LongPtr, ByVal bAlpha As Byte, ByVal dwFlags As LongPtr) As LongPtr
    Private Declare PtrSafe Function DrawMenuBar Lib "User32.dll" (ByVal HWnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetSystemMetrics Lib "USER32" (ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function ReleaseDC Lib "User32.dll" (ByVal HWnd As LongPtr, ByVal hDC As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetDC Lib "USER32" (ByVal HWnd As LongPtr) As Long
    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal HWnd As LongPtr, ByVal nIDEvent As LongLong, ByVal uElapse As LongPtr, ByVal lpTimerFunc As LongPtr) As Long
    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal HWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
    Private Declare PtrSafe Function AddFontResource Lib "gdi32" Alias "AddFontResourceA" (ByVal lpFilename As String) As LongPtr
    Private Declare PtrSafe Function RemoveFontResource Lib "gdi32" Alias "RemoveFontResourceA" (ByVal lpFilename As String) As LongPtr
    Private Declare PtrSafe Function AddFontMemResourceEx Lib "Gdi32.dll" (ByVal pbFont As LongPtr, ByVal cbFont As Integer, ByVal pdv As Integer, ByRef pcFonts As Integer) As LongPtr
 





Get Column Letter From A Cell Address And Increment The Column Letter

[Back to Search]

Here are some basic methods to get a Column Letter from a single Cell Address and then to increment the Cell Address to get the next Column Letter ie. H7 should return "H" and then "I". This is useful for building dynamic Ranges. I detail 3 ways of declaring the Cell Address Variable.

Sub Example1()

    ' // set a Constant
    'Const strAddress As String = "H7"
    ' or... Const strAddress As String = "$H$7"
    Dim strAddress As String
    strAddress = "H7"

    ' // output the actual Cell Address
    MsgBox Range(strAddress).Address

    ' // output the initial Column Letter of the Cell Address
    MsgBox Split(Range(strAddress).Address(1, 0), "$")(0)

    ' // output the Next Column Letter (substitute the 1 in the Column Offset(0, 1) to 2 for Column Letter "J")
    MsgBox Split(Range(strAddress).Offset(0, 1).Address(1, 0), "$")(0)

End Sub 





Get Column Letter And Row Number From Both Parts Of A Range

[Back to Search]

Here are some basic methods to get a Column Letter & Row Number from both parts of a Range ie. "A1:B2". The examples below will result in Column "A", Row "1", Column "B" & Row "2". This can be very useful when building dynamic Ranges.

Sub Example2()

    ' // select a Range for the Example
    Range("A1:B2").Select

    ' // identify the Column for the first part of the Range following the ":"
    MsgBox Split(Split(Selection.Address, ":")(0), "$")(1)

    ' // identify the Row for the first part of the Range following the ":"
    MsgBox Split(Split(Selection.Address, ":")(0), "$")(2)

    ' // identify the Column for the second part of the Range following the ":"
    MsgBox Split(Split(Selection.Address, ":")(1), "$")(1)

    ' // identify the Row for the second part of the Range following the ":"
    MsgBox Split(Split(Selection.Address, ":")(1), "$")(2)

End Sub
 





Store Keys And Items In The VBA Hidden Namespace

[Back to Search]

Here is an easy way of storing Keys & their respective Items in the VBA hidden Namespace. The example details storing, displaying and then deleting the Key & Item. I have also included the way to store Values using dummy VBA Variables. This data will persist until the Excel instance is closed.

Sub Example3()

    ' // store the Value for the "Key"
    Application.ExecuteExcel4Macro "SET.NAME(""Key"",""Item1"")"
    
    ' // display the stored Value for the "Key"
    MsgBox Application.ExecuteExcel4Macro("Key")
    
    ' // delete the "Key" & its respective Value
    Application.ExecuteExcel4Macro "SET.NAME(""Key"")"

    ' // storing VBA Variables
	Application.ExecuteExcel4Macro "SET.NAME( """ & PivotTableWorksheet & PivotTable & """ , """ & strAddress & """ )"

End Sub
 





How To Clear Multiple Cells Or Ranges On A Worksheet

[Back to Search]

To clear data in many Cells on a Worksheet you can use Code like this (this example picks up the Worksheet Name from a Defined Name called 'SheetName'):

Private Sub ClearReportData()

    ' // vars
    Dim strSheetName As String
    strSheetName = Range("SheetName").Value2

    Dim strCells As String
    strCells = "E6:E8, B14:C18, E14:G18, I14:J14, L14:N14, E23:E25, B31:C35, E31:G35, I31:J35, L31:N35, E40:E42, B48:C52, E48:G52, I48:J52, L48:N52"

    ' // clear the amed Ranges by prefixing the Named Range with the Worksheet Name
    With Worksheets(strSheetName)
        .Range(strCells).ClearContents
    End With

End Sub
 

This example clears Named Ranges (Defined Names) by prefixing the Worksheet Name to "_data". So to clear all of the Cells/Ranges in a Worksheet called "Monday" where you have setup a Defined Name called Monday_data as a Range for all of the Cells you want to clear use the following Code:
Private Sub ClearReportData()

' // vars
Dim strSheetName As String
strSheetName = Range("SheetName").Value2

' // clear the Named Ranges by prefixing the Named Range with the Worksheet Name
With Worksheets(strSheetName)
    .Range(strSheetName & "_data").ClearContents
End With

End Sub
 
This technique allows you to have different Defined Names for each Worksheet referring to different Cells ie. you can clear down different Cells/Ranges for different Worksheets. Setup your Defined Names like the example below:

Example of a Defined Name called:
Monday_data

Formula:
=Monday!$E$6:$E$8,Monday!$B$14:$C$18,Monday!$E$14:$G$18,Monday!$I$14:$J$18,Monday!$L$14:$N$18,Monday!$E$23:$E$25,Monday!$B$31:$C$35,Monday!$E$31:$G$35,Monday!$I$31:$J$35,Monday!$L$31:$N$35,Monday!$E$40:$E$42,Monday!$B$48:$C$52,Monday!$E$48:$G$52,Monday!$I$48:$J$52,Monday!$L$48:$N$52





Inserting A New Record ID Into A Column Using The Application.WorksheetFunction

[Back to Search]

To insert a New Record in a Column you can use the Application.WorksheetFunction. This Code will insert the next available ID using the MAX() Function into Column A on the active Worksheet:

Sub InsertRecord()

    Dim rngNewRecord As Range

    Set rngNewRecord = Range("A1").End(xlDown).Offset(1, 0)
    rngNewRecord.Value2 = WorksheetFunction.Max(ActiveCell.EntireColumn) + 1

End Sub
 





Toggle Or Minimize the Ribbon As Opposed To Actually Hiding It

[Back to Search]

If you are searching for a way to Minimize the Ribbon as opposed to actually hiding it, then use the following Code to Minimize the Ribbon if it is Maximized instead of the SendKeys approach:

 
Sub MinimizeRibbon()
 
 If Application.CommandBars.Item("Ribbon").Height > 80 Then _
  Application.CommandBars.ExecuteMso "MinimizeRibbon"
 
End Sub

 
Or to Toggle the Ribbon Minimize/Maximize use this:
 
Sub ToggleRibbon()
 
 Application.CommandBars.ExecuteMso "MinimizeRibbon"
 
End Sub

 





Looping Worksheets By Array Of Sheet Names Or Code Name

[Back to Search]

Here are some basic methods to iterate Worksheets by an Array of Sheet Names, by Sheet Names & by Code Names. The last Example allows you to set the Worksheet Object by the Sheet Code Name.

Option Explicit

Private Sub LoopWorksheetsbyArrayOfSheetNames()

    ' // vars
    Dim Sheet As Worksheet

    ' // loop by Worksheet Name i.e. "Sheet1", "foobar" etc.
    '    explicit Workbook reference
    For Each Sheet In ThisWorkbook.Worksheets(Array("Sheet1", "Sheet3"))

        Sheet.Activate

    Next Sheet

    Set Sheet = Nothing

End Sub

Private Sub LoopWorksheetsbySheetNames()

    ' // vars
    Dim Sheet As Worksheet

    ' // loop by Worksheet Name i.e. "Sheet1", "foobar" etc.
    '    explicit Workbook reference
    For Each Sheet In ThisWorkbook.Worksheets

        Select Case Sheet.Name

            Case "Sheet1", "Sheet3"

                Sheet.Activate

        End Select

    Next Sheet

    Set Sheet = Nothing

End Sub

Private Sub LoopWorksheetsbyCodeNames()

    ' // vars
    Dim Sheet As Worksheet

    ' // loop by Code Name i.e. Sheet1, foobar etc.
    '    explicit Workbook reference
    For Each Sheet In ThisWorkbook.Worksheets

        Select Case Sheet.CodeName

            Case "Sheet1", "Sheet3"

                Sheet.Activate

        End Select

    Next Sheet

    Set Sheet = Nothing


End Sub

Private Sub SetWorksheetObjectNameByCodeName()

    ' // vars
    Dim Sheet As Worksheet

    ' // set a reference to the Worksheet Object by the Worksheet Code Name i.e. Sheet1 called "foobar"
    Set Sheet = ActiveWorkbook.Sheets(ActiveWorkbook.VBProject.VBComponents("foobar").Properties("Name").Value)
    MsgBox Sheet.Name

End Sub
 





Fast method To Derive The Counts Of Occurances From An Entire Column

[Back to Search]

A fast method to Derive the Counts of Occurances from an Entire Column (1,048,576 Rows). This is like running a "=COUNTIF(A:A,A1)" Formula on Column A for each Cell. Download the File from the link below:

Press ALT+F8 and run the VBACountIfReplacement() Macro to build the Unique List and Counts on a Million+ Row Range. Results vary depending on the data, the amount of Rows of data and the speed of your PC, however 100,000 Rows will take under 1 second - trying doing that using an actual Formula! The Counts will be output in Column B. You can Filter the data and select a Number to check that the Counts are correct. The Code uses a modified version of my Multiplex Array Class and a Dictionary Object to complete the task. The Code requires a reference to Tools->References... Microsoft Scripting Runtime. Press ATL+F11 to view the Code

Watch a Video
Watch a Video on a Fast Method to Derive the Counts of Occurances from an Entire Column (1,048,576 Rows)

VBA CountIf Replacement.xlsb (8.41 MB)





Fast Method To Declare And Populate A Default Value In An Array

[Back to Search]

A fast method to Declare and Populate a Default Value in an Array. We will use an API called FillMemory. We will Declare an Array of 1,048,576 bytes and then fill it with the default Value of 1. This will take a fraction of a second. Add the Code to a Standard Module and press F5

Option Explicit
 
Private Declare Sub FillMemory Lib "kernel32" Alias "RtlFillMemory" (dest As Any, ByVal size As Long, ByVal fill As Byte)
 
Private Sub FillMemoryExample()
 Dim MyArray(1 To 1048576) As Byte
 FillMemory MyArray(1), 1048576, 1
End Sub
 
And this additional method for other types taken from stackoverflow, VBA (Excel) Initialize Entire Array without Looping:
Option Explicit

Private Declare Sub FillMemory Lib "kernel32" Alias "RtlFillMemory" (dest As Any, ByVal size As Long, ByVal fill As Byte)

Sub StuffNArrs()
    Dim i(0 To 4) As Long
    Dim j(0 To 4) As Integer
    Dim u(0 To 4) As Currency
    Dim f(0 To 4) As Single
    Dim g(0 To 4) As Double

    FillMemory i(0), 5 * LenB(i(0)), &HFF    'gives -1
    FillMemory i(0), 5 * LenB(i(0)), &H80    'gives -2139062144
    FillMemory i(0), 5 * LenB(i(0)), &H7F    'gives 2139062143
    FillMemory j(0), 5 * LenB(j(0)), &HFF    'gives -1
    FillMemory u(0), 5 * LenB(u(0)), &HFF    'gives -0.1
    FillMemory f(0), 5 * LenB(f(0)), &HFF    'gives -1.#QNAN
    FillMemory f(0), 5 * LenB(f(0)), &H80    'gives -1.18e-38
    FillMemory f(0), 5 * LenB(f(0)), &H7F    'gives 3.40e+38
End Sub
 





Fast Method To Purge Or Inverse Purge Data From Two Columns Of Text And Numeric Data

[Back to Search]

A fast method to Purge or Inverse Purge data from 2 Columns of Text and Numeric data. That's 2,097,152 Cells of data in 1.9 seconds for an Inverse Purge (retain data according to some Criteria) and 5.8 seconds for a normal Purge (delete data according to some Criteria)

Download and Open the File from the link below. Press the Buttons to perform a Purge or Inverse Purge. Press ALT+F11 to view the Code

Multiplex Purge.xlsb (16.1 MB)





An Ultra Fast UDF To Use In Excel Or VBA To Derive A Unique Count From A Range

[Back to Search]

This is an Ultra-fast UDF to use in Excel or VBA to derive a Unique Count from a Range. The Code works by building a Dictionary of the Unique values. You can pass the Range as a Worksheet Range or a Defined Name. An example of using the UDF in Excel would be ="Unique SKUS in this Report: "&TEXT(CountUnique($B$9:$B$81880),"#,##0") or ="Unique SKUS in this Report: "&TEXT(CountUnique(FilteredRange),"#,##0"). Don't believe how fast this is? ...then try it for yourself. I use this on over 100,000 Rows of data and even when using the AutoFilter it is still instant:

Public Function CountUnique(CellRange As Range) As Long
    On Error Resume Next
 
    ' // you can choose to set or not set this.  if you set it, then it will fire on event handlers for Cell Selections etc.
    ' Application.Volatile
     
    ' // turn off Screen drawing
    Application.ScreenUpdating = False
 
    ' // Vars
    Dim lngY As Long
    Dim vntData As Variant
    ' // use late binding.  uncomment the Dictionary & New Dictionary to use early binding
    Dim objDictionary As Object 'Dictionary
 
    ' // initialise the Dictionary
    Set objDictionary = CreateObject("Scripting.Dictionary") 'New Dictionary
    objDictionary.CompareMode = BinaryCompare
 
    ' // pickup all of the data to perform the Count
    vntData = CellRange
 
    ' // build the Unique Count
    For lngY = 1 To UBound(vntData)
        If vntData(lngY, 1) <> "" And Not objDictionary.Exists(vntData(lngY, 1)) Then
            objDictionary.Add vntData(lngY, 1), 1
        End If
    Next lngY
 
    ' // return the Count
    CountUnique = objDictionary.count
 
    ' // clean up
    Set objDictionary = Nothing
    Erase vntData
 
End Function
 





Fast Method To Derive A Unique List And A Count Of The Occurances From An Entire Column

[Back to Search]

A fast method to Derive a Unique List & a Count of the Occurances from an Entire Column (1,048,576 Rows). Download the File from the link below:

Press ALT+F8 and run the BuildUniqueListWithCounts() Macro to build the Unique List and Counts on a Million+ Row Range. This will take just over 1 second. The Code uses a Dictionary Object to complete the task. The Code requires a reference to Tools->References... Microsoft Scripting Runtime. Press ATL+F11 to view the Code

Count Unique List with Counts.xlsb (8.19 MB)





Open multiple files or Workbooks Iterate Worksheets and Copy the Data as Special Values into a Single Worksheet

[Back to Search]

A Fast method to open multiple Files, iterate the Workbook and pull in all of the data into a single Worksheet as Special Values. The Workbook is Saved as .XLSB to compress the data when retrieving large amounts as you have the option to Save any data retrieved. I have left the Code to pull in all data for "Sheet1" & "Sheet2" of another Workbook. The data in the other Workbooks should have Headers as the Code will pick up everything underneath the headers appending it to "Sheet1" in the Download Workbook building up a mass of data as Special Values. You can setup the Headers that you want in the Download File - it is advisable that they match the data you are pulling in, but they do not have to. If the Code encounters a blank/empty Worksheet it will skip over the Worksheet. Ultimately the process will pull in all of the data into the single Worksheet, "Sheet1" in the Download Workbook

Version 1
Get Data as Values.xlsb (25 KB)
Version 2 (with Preloader spinner)
Get Data as Values v2.xlsb (25 KB)

Download and Open the File from the link above. The Workbook will begin it's automation and prompt you for the Folder/Directory to open multiple Workbooks/Excel Files (Please Note: the default Folder upon opening is relative to where you Saved the Download Workbook). If you want, you can Cancel the process and manually press ALT+F8 & run the GetDataAsValues() Macro or Clear the data using the ClearData() macro. Once ran you are left with all of your data in a single Worksheet, "Sheet1"

You can test out Version 2 which includes my Preloader animation for waiting on long tasks (some of my File I read in are BEx Workbooks with 28 Worksheets in them). I set the Preloader to Fade in quickly run whilst the tasks are being performed and then Fade out nicely at the end. The routine uses the MyDoEvents workaround to stop screen flicker during the Copy & Paste routines





Embed Documents and Images as Worksheets Into Excel

[Back to Search]

This Code will allow you to select select an Excel File (*.XLSX, *.XLS) or Image File (*.JPG, *.PNG) and embed it into a separate Worksheet within the current File. You can easily modify the Code to allow more File Types or even to return Multiple Files as an Array

File:
Embed Documents & Images as Worksheets Into Excel.xlsm (30.2 KB)