VBA – Tips & Tricks

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!

Excel formula – Miscellaneous

I recently had to work with Excel formulas, and I encountered a small challenge. The problem was this: I had a table with variating height (the user could add and delete rows), that was likely to sometimes have 0 rows.Also, it wasn’t just the sum of the whole column I needed, as the SUM value should be at the bottom of the table, and a circular loop should be avoided. Therefore, the usual SUM() didn’t work.

I did not want to use VBA for this problem, so I turned to this solution:

Example: Column A: Names – Column B: Salary

1) Find the last cells that isn’t empty (in column A).
2) Make a SUM()-formula in column B that can take the row number from 1) as a parameter.

1) (Danish)

=(SUMPRODUKT(MAKS((A4:A65003<>"")*RÆKKE(A4:A65003)))) 

(English)

=(SUMPRODUCT(MAX((A4:A65003<>"")*ROW(A4:A65003))))

To make the solution understandable, I will enter the above formula in cell G1. Now, I have defined the last row(G1), and I just need a fixed first row, which I define as 2: I need to use the SUM() and the INDEKS() to sum the variable amount of rows:

(Danish)

=SUM(INDEKS(B:B;2):INDEKS(B:B;G1))

(English)

=SUM(INDEX(B:B;2):INDEX(B:B;G1))

Of course, put togther, it looks like this:

=SUM(INDEKS(B:B;2):INDEKS(B:B;(=(SUMPRODUKT(MAKS((A4:A65003<>"")*RÆKKE(A4:A65003)))) )))

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