VBA – Tips & Tricks

VBA – Check Extension of File

When looping through all files in a folder, it’s often necessary to check the extension of each file, so you only mess with Excel files, for example.

The code below shows how to retrieve the extension of a file, define an array with “allowed” extensions, and match the extension of the file to the array.

Sub KørImport()

Dim MinExtensionX
Dim Arr() As Variant
Dim lngLoc As Variant

'Retrieve extension of file
MinExtensionX = Mid(MyFile.Name, InStrRev(MyFile.Name, ".") + 1)

Arr = Array("xls", "xlsx") 'define which extensions you want to allow
On Error Resume Next
lngLoc = Application.WorksheetFunction.Match(MinExtensionX, Arr(), 0)
If Not IsEmpty(lngLoc) Then ' 

'DO STUFF if it's an xls/xlsx file. Otherwise, chose next file in folder

End If


     

VBA – Delete PivotTables

This code snippet shows how to loop through all pivot tables in all worksheets and delete them:

Sub DeletePivotTables()

    Dim Pt As PivotTable
    Dim Ws As Worksheet
    
'Loop through worksheets 
    For Each Ws In ActiveWorkbook.Worksheets
    Worksheets(Ws.Name).Select

'Loop through pivot tables         
    For Each Pt In Ws.PivotTables
           
'Delete pivot table
           Pt.PivotSelect "", xlDataAndLabel, True
    Selection.Delete Shift:=xlToLeft

            'Exit Sub 'Optional: Get out
        Next Pt
    Next Ws
End Sub  

VBA – Looping through all files in a folder

This posts looks a lot like my previous – but it’s a bit simpler. Here I just show how to loop through files in a specific folder, which the user has chosen in a modal window.

Sub ListFiles()

Dim fd As FileDialog
Dim PathOfSelectedFolder As String
Dim SelectedFolder
Dim SelectedFolderTemp
Dim MyPath As FileDialog
Dim fs
Dim ExtraSlash
ExtraSlash = "\"
Dim MyFile

'Prepare to open a modal window, where a folder is selected
Set MyPath = Application.FileDialog(msoFileDialogFolderPicker)
With MyPath
'Open modal window
        .AllowMultiSelect = False
        If .Show Then
            'The user has selected a folder
            
            'Loop through the chosen folder
            For Each SelectedFolder In .SelectedItems

                'Name of the selected folder
                PathOfSelectedFolder = SelectedFolder & ExtraSlash
               
                Set fs = CreateObject("Scripting.FileSystemObject")
                Set SelectedFolderTemp = fs.GetFolder(PathOfSelectedFolder)
                    
                    'Loop through the files in the selected folder
                    For Each MyFile In SelectedFolderTemp.Files
                        'Name of file
                        MsgBox MyFile.Name
                        'DO STUFF TO THE FILE, for example:
                        'Open each file: 
                        'Workbooks.Open FileName:=MyFile
                        
                    Next

               
            Next
        End If
End With

End Sub

VBA – Create and add items to dynamic arrays

This posts shows two things: Its shows how to find a value in a sheet without looping, and instead using the functions .Find and .CountIf, and how to create and add items to a dynamic array.

The problem I faced was that I had some answers to questions in a worksheet, and some of those answers had to be added as answers to questions in another worksheet. But the users in the original worksheet had in some cases added new questions and answers (rows and columns) to the questions, so I couldn’t just copy and paste it without chekcing the content and making sure the answers were posted along side the correct questions.

So, the code below first defines the questions I want to find, then finds the questions in the worksheet and saves the answers to a dynamic array. The next step is of course to add the answers to the other workwheet, and to transfer the questions and answers added by the user, but it’s not part of the example.

 

Dim Questions As Variant
Dim x As Integer
Dim myrow As Integer
Dim myColumn As Integer
Dim myValue

Dim Answers() As String    'Array of answers
Dim lngPosition As Long    'Counting
blDimensioned = False

'Array of questions
Questions = Array("Navn", "Ansat i fleksjob - Dato?", "Ansat den", "Bevillingsdato", "Evt. ophørsdato", "Kommune", "Tilskudsberettiget lønindplacering i SLS ")

'Go through the array of questions
'We want to find each of them in the worksheet

For x = LBound(Questions) To UBound(Questions)


Dim rowFound, columnFound

'If the question is not found in the worksheet, then just skip to the next item in the array
If WorksheetFunction.CountIf(Cells, Questions(x)) = 0 Then
GoTo NotFound
End If


'Find the x item in the array
Cells.Find(What:=(Questions(x)), After:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate

'Found: Get the row and the column number of the answe to the question (the next column after the question
myrow = ActiveCell.row
myColumn = ActiveCell.Column + 1
myValue = Cells(myrow, myColumn)

'We have the answer.
'Add the answer to the the Answer array.

If myValue = "" Then myValue = " "
              
        'The array is dimensioned in the first loop
        If blDimensioned = True Then
                  
            'The array is extended, so we extend the array
            ReDim Preserve Answers(0 To UBound(Answers) + 1) As String
                      
        Else
                  
            'The array is not dimensined, so we dimension it and flag it as dimensioned.
            ReDim Answers(0 To 0) As String
            blDimensioned = True
                      
        End If
                  
        'Add the answer to the last element of the array
        Answers(UBound(Answers)) = myValue



NotFound:

Next x

VBA – Loop through arrays

This post shows how to define an array, and to loop through each of the items in it. So many more things can be done with arrays (resizing, adding, deleting items, etc.) but for now I’ll just show how to loop through them.. that’s always useful.

Dim myArray As Variant
Dim x As Integer

myArray = Array(34610, 92105, 92263, 94121) 'define array

For x = LBound(myArray) To UBound(myArray) 'define start and end of array

MsgBox (myArray(x))

Next x ' Loop!

VBA – Delete all files in a folder

This code snippet shows how you can delete all files in a given folder in a VBA application.

Sub deleteFiles()
dim myPath
myFolder = "C:\MyFolder1\Myfolder2"      
Set Fso = CreateObject("Scripting.FileSystemObject") ' Get a File object to query.
Set Fldr = Fso.GetFolder(myFolder)
                
For Each Filename In Fldr.Files
    Filename.Delete True ' delete all files
Next
End Sub

That’s it!

VBA – Loop through sheets

This code snippet can be used if you want to loop thorugh the sheets in your workbook, either because you want to add something to everysheet, or – as in the example – you want to delete sheets with a specific name.

Sub slet_Faner()
Application.DisplayAlerts = False ' Makes it unnecessary for the user to approve the deletion

Dim ws As Worksheet
   For Each ws In Worksheets
           If ws.Name = "Home" Then ws.Delete 'Delete if name of sheet is "Home"
    Next

Application.DisplayAlerts = True
End Sub

Of course, if you want all sheets BUT the one sheet with a specific name, you just use:

Dim ws As Worksheet
   For Each ws In Worksheets
      If ws.Name <> "Home" Then ws.Delete 'Delete if name of sheet ISN'T "Home"
    Next

VBA UserForm – How to automatically switch to next Textbox

The code-snippet presented in this very first post on my blog is helpful when the user has to enter data in TextBoxes in a UserForm, using VBA for Excel.

What we want to achieve is that whenever the user has entered 6 characters in TextBox1, then TextBox2 is selected by default. That way, the user does not need to used either TAB or the mouse to select the next TextBox:

We will need to create a sub that is called whenever a Change is made to TextBox1. We need to use the TextLength and the SetFocus, like shown below:

Private Sub TextBox1_Change()
           'whenever there are 6 characters registered in the TextBox
           If TextBox1.TextLength = 6 Then
            'select (SetFocus) the next TextBox
           TextBox2.SetFocus
End If

Of course, the code-snippet has to be added in the code-behind of the UserForm. Make sure that you have build your Sub correctly by verifying that you have chosen TextBox1 and Change, and not just General at the top of the page: