Category Archives: Excel

Excel

Random Number Generator in Excel / VBA

(1 votes, average: 5.00 out of 5)

March 14, 2019 Tom (AnalystCave)

We will explore the options to create your own random number generator in an Excel Worksheet or in VBA (Macro). You can generate randoms in 2 ways:

Using Excel functions i.e. using the RAND or RANDBETWEEN functions
Using VBA (Visual Basic macro) using the RANDOMIZE and RND functions

Random Number Generator using Excel functions

To create a random number in Excel you have 3 options:

Numbers between 0-1 using RAND function:
Numbers between 2 whole numbers (lower and upper boundry, inclusive) using RANDBETWEEN. Below example for numbers between 0-100.
Any decimal number between 2 numbers using the RAND function. Simply follow the pattern below (replace LOWER_BOUNDRY and UPPER_BOUNDRY with your values):

Visual Basic

= LOWER_BOUNDRY + UPPER_BOUNDRY*RAND()

1

= LOWER_BOUNDRY + UPPER_BOUNDRY*RAND()

. Example below generating any decimal numbers between 0-100 e.g. 1.5.

Remember that the RAND and RANDBETWEEN functions are volatile, meaning they will be recalculated on any change to the worksheet regardless if it affects the formula. This may mean you will see constant changes to these numbers. In case it affects your performance be sure to replace your random numbers with static (copy paste as values) or generate them using VBA.

Random Numbers using VBA functions

To generate random numbers in VBA you need to use 2 functions:

Randomize – that initializes the Rnd function with a provided seed. If you leave the argument blank it will use the actual system timer value. If you provide a certain number e.g. 10 you will always get the same sequence of random numbers. Why? Because computers use pseudo random number generators.
Rnd – function that generates the actual random decimal numbers between 0-1.

Below a simple example:

Dim myRandom as Double
Randomize 'Initialize the Rnd function
 
myRandom = Rnd 'Generate a random number between 0-1

Debug.Print myRandom 'Print the number on console e.g.  0.308616280555725

Dim myRandom as Double

Randomize 'Initialize the Rnd function

myRandom = Rnd 'Generate a random number between 0-1

Debug.Print myRandom 'Print the number on console e.g. 0.308616280555725

VBA Generate whole numbers

To generate whole numbers similarly like the RANDBETWEEN Excel function we need to use the VBA CInt function to convert the decimal number to an Integer:

Dim myRandom As Double
Randomize 'Initialize the Rnd function
 
myRandom = CInt(Rnd * 100) 'Generate a random number between 0-100

Debug.Print myRandom 'e.g. 25

Dim myRandom As Double

Randomize 'Initialize the Rnd function

myRandom = CInt(Rnd * 100) 'Generate a random number between 0-100

Debug.Print myRandom 'e.g. 25

The above is limited to numbers starting at 0 up to the upper boundry (above 100). We can adjust the lower and upper boundries adjusting the formula above:

Dim myRandom As Double
Randomize 'Initialize the Rnd function
 
myRandom = CInt(5 + Rnd * 95) 'Generate a random number between 5-100

Debug.Print myRandom 'e.g. 5

Dim myRandom As Double

Randomize 'Initialize the Rnd function

myRandom = CInt(5 + Rnd * 95) 'Generate a random number between 5-100

Debug.Print myRandom 'e.g. 5

The above will generate numbers between 5 and 100.

VBA Generate decimal numbers

Using similar approach as above and removing the VBA CInt function we can generate decimal numbers between any 2 given numbers:

Dim myRandom As Double
Randomize 'Initialize the Rnd function
 
myRandom = 5 + Rnd * 95 'Generate a random decimal number between 5-100

Debug.Print myRandom 'e.g. 5.4242442

Dim myRandom As Double

Randomize 'Initialize the Rnd function

myRandom = 5 + Rnd * 95 'Generate a random decimal number between 5-100

Debug.Print myRandom 'e.g. 5.4242442

Excel, MS Office

VBA Run Macro on All Files in a Folder / All Worksheets in a Workbook

(1 votes, average: 5.00 out of 5)

March 12, 2019 Tom (AnalystCave)

A very popular Excel automation scenario is the need to a VBA run macro on all files in a folder or running VBA on all Worksheets in an Excel Workbook. This is a very typical case where you process similar data dump files and want to extract data or transform the workbook. In this post I will provide ready code snippets to address these scenarios and walk you through what happens.

VBA Run Macro on All Files in a Folder

To run macro on all files in folder use the code snippet below. The code will do the following:

Open a VBA FileDialog in the current workbook path and ask for you to select a folder where all files are stored
It will open a separate Excel process (Application) and then open each file one by one
Replace the YOUR CODE HERE section with any code you want to run on every opened workbook
Each opened workbook will be closed w/o saving

To make it more simple currWb and currWS represent the ActiveWorkbook and ActiveWorksheet whereas wb represents the newly opened Workbook from the selected folder.

Sub RunOnAllFilesInFolder()
    Dim folderName As String, eApp As Excel.Application, fileName As String
    Dim wb As Workbook, ws As Worksheet, currWs As Worksheet, currWb As Workbook
    Dim fDialog As Object: Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    Set currWb = ActiveWorkbook: Set currWs = ActiveSheet

    'Select folder in which all files are stored
    fDialog.Title = "Select a folder"
    fDialog.InitialFileName = currWb.Path
    If fDialog.Show = -1 Then
      folderName = fDialog.SelectedItems(1)
    End If
    
    
    'Create a separate Excel process that is invisibile
    Set eApp = New Excel.Application:  eApp.Visible = False
    
    'Search for all files in folder [replace *.* with your pattern e.g. *.xlsx]
    fileName = Dir(folderName & "\*.*")
    Do While fileName <> ""
        'Update status bar to indicate progress
        Application.StatusBar = "Processing " & folderName & "\" & fileName


        Set wb = eApp.Workbooks.Open(folderName & "\" & fileName)
        '...
        'YOUR CODE HERE
        '...
        wb.Close SaveChanges:=False 'Close opened worbook w/o saving, change as needed
        Debug.Print "Processed " & folderName & "\" & fileName 
        fileName = Dir()
    Loop
    eApp.Quit
    Set eApp = Nothing
    'Clear statusbar and notify of macro completion
    Application.StatusBar = ""
    MsgBox "Completed executing macro on all workbooks"
End Sub

Sub RunOnAllFilesInFolder()

Dim folderName As String, eApp As Excel.Application, fileName As String

Dim wb As Workbook, ws As Worksheet, currWs As Worksheet, currWb As Workbook

Dim fDialog As Object: Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)

Set currWb = ActiveWorkbook: Set currWs = ActiveSheet

'Select folder in which all files are stored

fDialog.Title = "Select a folder"

fDialog.InitialFileName = currWb.Path

If fDialog.Show = -1 Then

folderName = fDialog.SelectedItems(1)

End If

'Create a separate Excel process that is invisibile

Set eApp = New Excel.Application: eApp.Visible = False

'Search for all files in folder [replace *.* with your pattern e.g. *.xlsx]

fileName = Dir(folderName & "\*.*")

Do While fileName <> ""

'Update status bar to indicate progress

Application.StatusBar = "Processing " & folderName & "\" & fileName

Set wb = eApp.Workbooks.Open(folderName & "\" & fileName)

'...

'YOUR CODE HERE

'...

wb.Close SaveChanges:=False 'Close opened worbook w/o saving, change as needed

Debug.Print "Processed " & folderName & "\" & fileName

fileName = Dir()

Loop

eApp.Quit

Set eApp = Nothing

'Clear statusbar and notify of macro completion

Application.StatusBar = ""

MsgBox "Completed executing macro on all workbooks"

End Sub

There is also built in simple progress tracking via the Application StatusBar.

VBA Run Macro on All Files in Subfolders

A scenario of the above case when you want to run a macro on all Excel files in a folder is also traversing all subfolders to run your macro. The below is an extension of the above and utilizes a slightly modified version of the TraversePath procedure from here.

The below is almost identical to the above, however, notice the global variable fileCollection. This will be used to first store all file identified in subfolders and only after used to run all macros on files stored in this VBA Collection.

Dim fileCollection As Collection
Sub TraversePath(path As String)
    Dim currentPath As String, directory As Variant
    Dim dirCollection As Collection
    Set dirCollection = New Collection
    
    currentPath = Dir(path, vbDirectory)
    
    'Explore current directory
    Do Until currentPath = vbNullString
        Debug.Print currentPath
        If Left(currentPath, 1) <> "." And (GetAttr(path & currentPath) And vbDirectory) = vbDirectory Then
            dirCollection.Add currentPath
        ElseIf Left(currentPath, 1) <> "." And (GetAttr(path & currentPath) And vbNormal) = vbNormal Then
            fileCollection.Add path & currentPath
        End If
        currentPath = Dir()
    Loop
    
    'Explore subsequent directories
    For Each directory In dirCollection
        Debug.Print "---SubDirectory: " & directory & "---"
        TraversePath path & directory & "\"
    Next directory
End Sub

Sub RunOnAllFilesInSubFolders()
    Dim folderName As String, eApp As Excel.Application, fileName As Variant
    Dim wb As Workbook, ws As Worksheet, currWs As Worksheet, currWb As Workbook
    Dim fDialog As Object: Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    Set currWb = ActiveWorkbook: Set currWs = ActiveSheet

    'Select folder in which all files are stored
    fDialog.Title = "Select a folder"
    fDialog.InitialFileName = currWb.path
    If fDialog.Show = -1 Then
      folderName = fDialog.SelectedItems(1)
    End If
    
    
    'Create a separate Excel process that is invisibile
    Set eApp = New Excel.Application:  eApp.Visible = False
    
    'Search for all files in folder [replace *.* with your pattern e.g. *.xlsx]
    Set fileCollection = New Collection
    TraversePath folderName & "\"

    For Each fileName In fileCollection
        'Update status bar to indicate progress
        Application.StatusBar = "Processing " & fileName


        Set wb = eApp.Workbooks.Open(fileName)
        '...
        'YOUR CODE HERE.
        '...
        wb.Close SaveChanges:=False 'Close opened worbook w/o saving, change as needed
        Debug.Print "Processed " & fileName  'Print progress on Immediate window
    Next fileName
    eApp.Quit
    Set eApp = Nothing
    'Clear statusbar and notify of macro completion
    Application.StatusBar = ""
    MsgBox "Completed executing macro on all workbooks"
End Sub

Dim fileCollection As Collection

Sub TraversePath(path As String)

Dim currentPath As String, directory As Variant

Dim dirCollection As Collection

Set dirCollection = New Collection

currentPath = Dir(path, vbDirectory)

'Explore current directory

Do Until currentPath = vbNullString

Debug.Print currentPath

If Left(currentPath, 1) <> "." And (GetAttr(path & currentPath) And vbDirectory) = vbDirectory Then

dirCollection.Add currentPath

ElseIf Left(currentPath, 1) <> "." And (GetAttr(path & currentPath) And vbNormal) = vbNormal Then

fileCollection.Add path & currentPath

End If

currentPath = Dir()

Loop

'Explore subsequent directories

For Each directory In dirCollection

Debug.Print "---SubDirectory: " & directory & "---"

TraversePath path & directory & "\"

Next directory

End Sub

Sub RunOnAllFilesInSubFolders()

Dim folderName As String, eApp As Excel.Application, fileName As Variant

Dim wb As Workbook, ws As Worksheet, currWs As Worksheet, currWb As Workbook

Dim fDialog As Object: Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)

Set currWb = ActiveWorkbook: Set currWs = ActiveSheet

'Select folder in which all files are stored

fDialog.Title = "Select a folder"

fDialog.InitialFileName = currWb.path

If fDialog.Show = -1 Then

folderName = fDialog.SelectedItems(1)

End If

'Create a separate Excel process that is invisibile

Set eApp = New Excel.Application: eApp.Visible = False

'Search for all files in folder [replace *.* with your pattern e.g. *.xlsx]

Set fileCollection = New Collection

TraversePath folderName & "\"

For Each fileName In fileCollection

'Update status bar to indicate progress

Application.StatusBar = "Processing " & fileName

Set wb = eApp.Workbooks.Open(fileName)

'...

'YOUR CODE HERE.

'...

wb.Close SaveChanges:=False 'Close opened worbook w/o saving, change as needed

Debug.Print "Processed " & fileName 'Print progress on Immediate window

Next fileName

eApp.Quit

Set eApp = Nothing

'Clear statusbar and notify of macro completion

Application.StatusBar = ""

MsgBox "Completed executing macro on all workbooks"

End Sub

Run VBA on All Worksheets

To run macro on all Sheets in Workbook you need to can use the code snippet below. Here is a walkthrough of the code:

Opens each worksheet in ActiveWorkbook that isn’t the ActiveSheet. This clause is to avoid running on Worksheet on which macro was activated assuming this is a working sheet, feel free to remove the If clause if needed.
Replace the YOUR CODE HERE section with any code you want to run on every opened Worksheet

Sub RunOnAllWorksheets()
    Dim folderName As String, eApp As Excel.Application, fileName As String
    Dim ws As Worksheet, currWs As Worksheet, currWb As Workbook
    Dim fDialog As Object: Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    Set currWb = ActiveWorkbook: Set currWs = ActiveSheet

    
    'Search for all files in folder [replace *.* with your pattern e.g. *.xlsx]
    
    For Each ws In Sheets
        If ws.Name <> currWs.Name Then
            'Update status bar to indicate progress
            Application.StatusBar = "Processing " & ws.Name
            '...
            'YOUR CODE HERE
            '...
            Debug.Print "Processed " & ws.Name
        End If
    Next ws
    'Clear statusbar and notify of macro completion
    Application.StatusBar = ""
    MsgBox "Completed executing macro on all worksheets"
End Sub

Sub RunOnAllWorksheets()

Dim folderName As String, eApp As Excel.Application, fileName As String

Dim ws As Worksheet, currWs As Worksheet, currWb As Workbook

Dim fDialog As Object: Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)

Set currWb = ActiveWorkbook: Set currWs = ActiveSheet

'Search for all files in folder [replace *.* with your pattern e.g. *.xlsx]

For Each ws In Sheets

If ws.Name <> currWs.Name Then

'Update status bar to indicate progress

Application.StatusBar = "Processing " & ws.Name

'...

'YOUR CODE HERE

'...

Debug.Print "Processed " & ws.Name

End If

Next ws

'Clear statusbar and notify of macro completion

Application.StatusBar = ""

MsgBox "Completed executing macro on all worksheets"

End Sub

Excel

Get VLOOKUP Multiple Matches – Multi INDEX MATCH in Excel

(2 votes, average: 5.00 out of 5)

February 3, 2019 Tom (AnalystCave)

The Excel VLOOKUP function by default allows you to find only a single match and will return the corresponding row of a selected column value. What if you want to find VLOOKUP multiple matches, not just the first one? In this post let us explore this more complicated scenario. Instead of VLOOKUP however we will use INDEX and MATCH.

Using the MATCH Function in Excel

To find the first MATCH of the “A” value in column B:B we use the following formula as shown on the image below:

=MATCH(E$1,$B$2:$B$10,0)

1	=MATCH(E$1,$B$2:$B$10,0)

See the scenario below:

Finding multiple matches in Excel

Now say we want to find all matches of “A” in column B:B as seen below.

Below the formulas in cells E2-E4. In E2 we find the corresponding row of the first “A”, then in subsequenty (E3-E4) we look for the rows of the next found “A”. You can drag this formula down as much times as needed.

'E2
=IFERROR(MATCH(E$1,$B$2:$B$10,0),"")

'E3 (drag this down)
=IFERROR(MATCH(E$1,OFFSET($B$2,E2,0,ROWS($B2:$B$10)-E2),0)+E2,"")

'E4 (dragged from E3)
=IFERROR(MATCH(E$1,OFFSET($B$2,E3,0,ROWS($B3:$B$10)-E3),0)+E3,"")

'E2

=IFERROR(MATCH(E$1,$B$2:$B$10,0),"")

'E3 (drag this down)

=IFERROR(MATCH(E$1,OFFSET($B$2,E2,0,ROWS($B2:$B$10)-E2),0)+E2,"")

'E4 (dragged from E3)

=IFERROR(MATCH(E$1,OFFSET($B$2,E3,0,ROWS($B3:$B$10)-E3),0)+E3,"")

VLOOKUP Multiple Matches

To do a multiple match VLOOKUP we simply need to expand on the above Multiple MATCH example and add the INDEX function like so:

'E2
=IFERROR(INDEX($A$2:$A$10,MATCH(F$1,$B$2:$B$10,0)),"")
'E3
=IFERROR(INDEX($A$2:$A$10,MATCH(F$1,OFFSET($B$2,F2,0,ROWS($B2:$B$10)-F2),0)+F2),"")
'E4 (simply drag the E3 formula down)
=IFERROR(INDEX($A$2:$A$10,MATCH(F$1,OFFSET($B$2,F3,0,ROWS($B3:$B$10)-F3),0)+F3),"")

'E2

=IFERROR(INDEX($A$2:$A$10,MATCH(F$1,$B$2:$B$10,0)),"")

'E3

=IFERROR(INDEX($A$2:$A$10,MATCH(F$1,OFFSET($B$2,F2,0,ROWS($B2:$B$10)-F2),0)+F2),"")

'E4 (simply drag the E3 formula down)

=IFERROR(INDEX($A$2:$A$10,MATCH(F$1,OFFSET($B$2,F3,0,ROWS($B3:$B$10)-F3),0)+F3),"")

Using VBA to do a VLOOKUP Multi Match

In case you want a more sophisticated approach to doing a multi match INDEX MATCH / VLOOKUP you can also use the VBA Dictionary to record all instances of all lookup values along with selected columns. A simple version of this approach can be found in my post about using VLOOKUP in VBA. Below, however, I expanded this example by using a VBA Collection inside the VBA Dictionary to store value associated with each match of every lookup value (basically creating a very simply tree-like structure).

Based on the “A1:B10” table above the VBA code below will create my dictionary dict object.

Dim dict As Object, col As Collection, item As Variant
    Set dict = CreateObject("Scripting.Dictionary")
    'Column B:B has my lookup values
    For Each r In Range("B:B").SpecialCells(xlCellTypeConstants)
        'Omit row with headers
        If r.Row = 1 Then GoTo NextR
        
        If dict.Exists(r.Value) Then
            Set col = dict(r.Value)
        Else
            Set col = New Collection
            'Column A:A has the values I want to find for each lookup
            Call dict.Add(r.Value, col)
        End If
        col.Add Range("A" & r.Row)
NextR:
    Next r

Dim dict As Object, col As Collection, item As Variant

Set dict = CreateObject("Scripting.Dictionary")

'Column B:B has my lookup values

For Each r In Range("B:B").SpecialCells(xlCellTypeConstants)

'Omit row with headers

If r.Row = 1 Then GoTo NextR

If dict.Exists(r.Value) Then

Set col = dict(r.Value)

Else

Set col = New Collection

'Column A:A has the values I want to find for each lookup

Call dict.Add(r.Value, col)

End If

col.Add Range("A" & r.Row)

NextR:

Next r

After creating the dictionary I can now print all values from column “A:A” for any value of column “B:B”:

For Each item In dict("A")
   Debug.Print item
Next item

'Result:
'2
'4
'7

For Each item In dict("A")

Debug.Print item

Next item

'Result:

Excel

How to unhide sheets in Excel? Unhide all Sheets in Excel VBA

(1 votes, average: 5.00 out of 5)

December 1, 2018 Tom (AnalystCave)

To unhide Sheets in Excel you need to right click on the Worksheet tab and select the Worksheet you want to unhide from the Unhide Window.

I will start by showing a way to manually unhide an Excel Worksheet using the Excel Unhide Window. Then I will show you a few tricks of how to unhide all Sheets in Excel using VBA. Lastly

Unhide Sheets in Excel

To unhide a Hidden Worksheet in Excel proceed as follows:

Right click on a the Worksheets tab
Click the Unhide button in the opened tab
Select the Worksheet you want to unhide and click Ok

Unhide Sheet using VBA

To Unhide a single Worksheet in Excel using VBA we need to use open the Visual Basic Editor. To do this quickly simply us this Excel Keyboard shortcut ALT+F11.

You can type the below in the Immediate window and hit Enter:

Sheets("NameOfWorksheet").Visible = xlSheetVisible

1	Sheets("NameOfWorksheet").Visible = xlSheetVisible

Where NameOfWorksheet is obviously the name of the Worksheet you want to Unhide in Excel.

Hide Sheet using VBA

If you want to Hide a Worksheet in Excel using VBA you can modify the code above. Instead of using xlSheetVisible just use xlSheetHidden:

Sheets("NameOfWorksheet").Visible = xlSheetHidden

1	Sheets("NameOfWorksheet").Visible = xlSheetHidden

This will hide the worksheet named NameOfWorksheet.

Unhide All Sheets in Excel using VBA

To unhide all Sheets in Excel we must revert to VBA as there is no other way to select multiple worksheets using the built in Excel Unhide window. Again let us open the Visual Basic Editor by using the Excel Keyboard shortcut ALT+F11. Next in the Immediate Window let us type:

For Each ws In Sheets:ws.Visible=xlSheetVisible:Next ws

1	For Each ws In Sheets:ws.Visible=xlSheetVisible:Next ws

Below the same code as above but spread across multiple lines. Let us run through this:

'Will loop through all worsheets in the ActiveWorkbook
For Each ws In Sheets
  'Sets the visibility of the Worksheet to true
  ws.Visible=xlSheetVisible
Next ws

'Will loop through all worsheets in the ActiveWorkbook

For Each ws In Sheets

'Sets the visibility of the Worksheet to true

ws.Visible=xlSheetVisible

Next ws

Unhide all Sheets by Name

In many cases you don’t necessarily want to Unhide all Sheets in Excel. Instead you might want to Unhide only a subset of the Hidden Worksheets using a name pattern.

Assume you want to Unhide all Worksheets that fall into a certain pattern where part of the name can be any sequence of characters. For this we can amend the code above using the VBA Like operator:

'Loop all worksheets in the Excel file
For Each ws In Sheets
  'If the name of the Worksheet starts with "Hidden" then...
  If ws.Name Like "Hidden*" Then
     '...make the worksheet visible
     ws.Visible = xlSheetVisible
  End If
Next ws

'Loop all worksheets in the Excel file

For Each ws In Sheets

'If the name of the Worksheet starts with "Hidden" then...

If ws.Name Like "Hidden*" Then

'...make the worksheet visible

ws.Visible = xlSheetVisible

End If

Next ws

Similarly as above we can wrap it up to a oneliner to run in the Immediate Window:

For Each ws In Sheets: ws.Visible=Iif(ws.Visible = xlSheetVisible or ws.Name Like "Hidden*",ws.Visible,xlSheetHidden):Next ws

1	For Each ws In Sheets: ws.Visible=Iif(ws.Visible = xlSheetVisible or ws.Name Like "Hidden*",ws.Visible,xlSheetHidden):Next ws

The code above will unhide all Worksheets which name starts with Hidden and suffixed by any number of characters e.g. numbers like in the example below:

What is happening is using the VBA For Each loop we are iterating through the VBA Collection of Worksheets. When a certain Worksheet name matches our VBA Like function statement we make it visible.

Button to Hide/Unhide Sheets

Lastly to learn how to Unhide Sheets in Excel we will sum up what we have learned and make a simple VBA UserForm to be able to quick manage visibily across the entire list of Excel Worksheets.

Create the UserForm

First you need to create a VBA UserForm with a VBA ListBox and a VBA CommandButton:

Program Initialize and Button Click

If you named your objects correctly past the following code into the VBA UserForm source code:

'Runs when the form is created. Lists all worksheets and selects visible ones
Private Sub UserForm_Initialize()
    Dim it As Long
    lSheets.MultiSelect = fmMultiSelectExtended 'Make sure more than 1 can Sheet can be selected
    For Each ws In ActiveWorkbook.Sheets
        lSheets.AddItem ws.Name
        lSheets.Selected(it) = IIf(ActiveWorkbook.Sheets(ws.Name).Visible = xlSheetVisible, True, False)
        it = it + 1
    Next ws
End Sub

'Runs when button is clicked
Private Sub cbRun_Click()
    'First make visible selected Worksheets as otherwise code might crash
    Dim i As Long
    For i = 0 To lSheets.ListCount - 1
        If lSheets.Selected(i) = True Then ActiveWorkbook.Sheets(lSheets.List(i)).Visible = xlSheetVisible
    Next i

    'Hide unselected Worksheets
    For i = 0 To lSheets.ListCount - 1
        If lSheets.Selected(i) = False Then ActiveWorkbook.Sheets(lSheets.List(i)).Visible = xlSheetHidden
    Next i
End Sub

'Runs when the form is created. Lists all worksheets and selects visible ones

Private Sub UserForm_Initialize()

Dim it As Long

lSheets.MultiSelect = fmMultiSelectExtended 'Make sure more than 1 can Sheet can be selected

For Each ws In ActiveWorkbook.Sheets

lSheets.AddItem ws.Name

lSheets.Selected(it) = IIf(ActiveWorkbook.Sheets(ws.Name).Visible = xlSheetVisible, True, False)

it = it + 1

Next ws

End Sub

'Runs when button is clicked

Private Sub cbRun_Click()

'First make visible selected Worksheets as otherwise code might crash

Dim i As Long

For i = 0 To lSheets.ListCount - 1

If lSheets.Selected(i) = True Then ActiveWorkbook.Sheets(lSheets.List(i)).Visible = xlSheetVisible

Next i

'Hide unselected Worksheets

For i = 0 To lSheets.ListCount - 1

If lSheets.Selected(i) = False Then ActiveWorkbook.Sheets(lSheets.List(i)).Visible = xlSheetHidden

Next i

End Sub

Run the UserForm

To put our code to the test all we need to do is create and show the ManageWorksheets VBA UserForm. The following VBA Procedures code needs to created in a VBA Module:

Sub ShowWorksheets()
    Dim mw As ManageWorksheets
    Set mw = New ManageWorksheets
    mw.Show
End Sub

Sub ShowWorksheets()

Dim mw As ManageWorksheets

Set mw = New ManageWorksheets

mw.Show

End Sub

When executed this is how it will look like:

Excel, MS Office

AutoFit Excel Rows and Columns

(2 votes, average: 4.50 out of 5)

November 17, 2018 Tom (AnalystCave)

Excel rows and columns sometimes needs to be expanded to fit their content. How to AutoFit in Excel? Fortunately Excel allows you to AutoFit Excel rows or Excel columns to its contents readjusting the height or width. In this post I will start with showing how to resize Excel rows and columns. Then I will demonstrate the AutoFit feature. Lastly I will show how using VBA we can AutoFit multiple rows of a table.

Resizing Excel Rows & Columns

Resizing Excel rows or columns is pretty straight forward. Simply grab the border of the row or column header and resize:

Rarely would we want our columns to change their width automatically, however, Microsoft as built in a feature to make it easier for rows to re-adjust their size automatically based on the contents of cells. All we need to do is set the Wrap Text property:

AutoFit Excel Rows & Columns

To AutoFit Excel row or column, instead of grabing the border of the a header row or column Double Left Click on the border. Excel will automatically adjust the row or column size.

AutoFit Excel Table with VBA

The above explains the basics of how to resize Excel rows or columns. However, data is dynamic – it is easier to review an entire table when rows are minimized, on the other hand to read entire contents of rows of data in Excel the rows need to be AutoFitted. Switching between both these states can be a drag hence I created a simple VBA Macro that either minimizes the size of my Excel tables or AutoFits them.

Let us assume we have an Excel Table with at least 1 column which contents usually exceed the height of a single Excel row. This will look like in the image below.

What I started doing above was converting the Excel range (with my data table) to something called an Excel Table which will make it look like this:

Now that we have our table let us add 2 VBA Macros to our VBA Project:

'Reduces the row height to 15 of all rows in Excel Table
Sub Minimize()
   Dim ws As Worksheet, lr As ListRow: Set ws = ActiveSheet
   For Each lr In ws.ListObjects(1).ListRows
    If Not (lr.Range.Cells.EntireRow.Hidden) Then lr.Range.RowHeight = 15
   Next lr
End Sub

'AutoFits all rows in Excel Table
Sub AutoFitRows()
   Dim ws As Worksheet, lr As ListRow: Set ws = ActiveSheet
   For Each lr In ws.ListObjects(1).ListRows
    If Not (lr.Range.Cells.EntireRow.Hidden) Then lr.Range.Cells.EntireRow.AutoFit
   Next lr
End Sub

'Reduces the row height to 15 of all rows in Excel Table

Sub Minimize()

Dim ws As Worksheet, lr As ListRow: Set ws = ActiveSheet

For Each lr In ws.ListObjects(1).ListRows

If Not (lr.Range.Cells.EntireRow.Hidden) Then lr.Range.RowHeight = 15

Next lr

End Sub

'AutoFits all rows in Excel Table

Sub AutoFitRows()

Dim ws As Worksheet, lr As ListRow: Set ws = ActiveSheet

For Each lr In ws.ListObjects(1).ListRows

If Not (lr.Range.Cells.EntireRow.Hidden) Then lr.Range.Cells.EntireRow.AutoFit

Next lr

End Sub

I added to my spreadsheet 2 buttons each connected to one of the above VBA Procedures. So conveniently now I can minimize my Excel rows or AutoFit all of them with just a single click like this:

Analyst Cave

Category Archives: Excel

Random Number Generator in Excel / VBA

Random Number Generator using Excel functions

Random Numbers using VBA functions

VBA Generate whole numbers

VBA Generate decimal numbers

VBA Run Macro on All Files in a Folder / All Worksheets in a Workbook

VBA Run Macro on All Files in a Folder

VBA Run Macro on All Files in Subfolders

Run VBA on All Worksheets

Get VLOOKUP Multiple Matches – Multi INDEX MATCH in Excel

Using the MATCH Function in Excel

Finding multiple matches in Excel

VLOOKUP Multiple Matches

Using VBA to do a VLOOKUP Multi Match

How to unhide sheets in Excel? Unhide all Sheets in Excel VBA

Unhide Sheets in Excel

Unhide Sheet using VBA

Hide Sheet using VBA

Unhide All Sheets in Excel using VBA

Unhide all Sheets by Name

Button to Hide/Unhide Sheets

Create the UserForm

Program Initialize and Button Click

Run the UserForm

AutoFit Excel Rows and Columns

Resizing Excel Rows & Columns

AutoFit Excel Rows & Columns

AutoFit Excel Table with VBA

Simply the best place to learn Excel VBA