Automate Excel

The following function will find the nth word in a string:

Function Find_nth_word(Phrase As String, n As Integer) As String
Dim Current_Pos As Long
Dim Length_of_String As Integer
Dim Current_Word_No As Integer
Find_nth_word = ""
Current_Word_No = 1
'Remove Leading Spaces
Phrase = Trim(Phrase)
Length_of_String = Len(Phrase)
For Current_Pos = 1 To Length_of_String
    If (Current_Word_No = n) Then
        Find_nth_word = Find_nth_word & Mid(Phrase, Current_Pos, 1)
    End If

    If (Mid(Phrase, Current_Pos, 1) = " ") Then
     Current_Word_No = Current_Word_No + 1
    End If
Next Current_Pos
'Remove the rightmost space
Find_nth_word = Trim(Find_nth_word)
End Function

It needs two arguments – the phrase that is to be searched and the word number:

Find_nth_word(“Automateexcel ls the worlds favourite Excel site”,4)

Will return “world”.

A blank is returned if the number of words in the phrase is less than the word number specified.

So: Find_nth_word(“Automateexcel ls the worlds favourite Excel site”,12)
Will return blank as there are not 12 words in the phrase “Automateexcel ls the worlds favourite Excel site”.

Download

To download the .XLSM file from this article, click here

The following code works opening a workbook. It automatically adds a new sheet and labels it with the date. It also checks to see that the sheet doesn’t already exist – to allow for the possibility of it being opened more than once a day.

This code makes use of the Workbook Open Event and must be placed in the workbook module under the “Open work Book” event. The function Sheet_Exist must be placed in a module and this checks whether or not the sheet exists:

Private Sub Workbook_Open()
Dim New_Sheet_Name As String
New_Sheet_Name = Format(Now(), "dd-mm-yy")
If Sheet_Exists(New_Sheet_Name) = False Then
    With Workbook
        Worksheets.Add().Name = New_Sheet_Name
    End With
End If
Save
End Sub

Function Sheet_Exists(WorkSheet_Name As String) As Boolean
Dim Work_sheet As Worksheet
Sheet_Exists = False
For Each Work_sheet In ThisWorkbook.Worksheets
      If Work_sheet.Name = WorkSheet_Name Then
        Sheet_Exists = True
    End If
   Next
End Function

To download the .XLSM file for this tutorial, click here

The following code will prompt the user for the name of a workbook. It will then create and save a new
workbook with the same name.

Private Sub CommandButton1_Click()
Dim Workbook_Name As String
Dim New_Workbook As Workbook
Set New_Workbook = Nothing
Workbook_Name = InputBox(Prompt:="Workbook Name.", Title:="Enter the WorkBook Name :")
Set New_Workbook = Workbooks.Add
With New_Workbook
.Activate
.SaveAs Workbook_Name
End With

End Sub

To download the .XLSM file for this article, click here

The following UDF will return the formulae for a given cell reference:

Function Show_Cell_Formulae(Cell As Range) As String
    Show_Cell_Formulae = "Cell " & Cell.Address & " has the formulae : ' " & Cell.Formula & " '"
End Function

So if we have:

Where the cell B7 has the formulae : ‘=MAX(B5:G5) then we can type in another cell:
B9 = Show_Cell_Formulae(b7)

And we get a text string with the cell reference and the formulae contained within it.

To download the .XLSM file for this article, click here

Imagine that we have the following 2 lists each consisting of 3 columns of data:

And we need to find those items that are in List 1 that are in List 2. However ALL 3 columns of data must match for items to be in both lists. One way would be to construct a comprehensive IF function. However this could get to be a messy formulae.

An alternative would be to construct some helper columns . Helper columns are additional columns that can reduce the need for complex or cumbersome formulae. In this case the Helper columns are the individual list items concatenated into a single string.

So in cell D6 we have:
D6 = A6&” “&B6&” “&C6 and:
I6 = F6&” “&G6&” “&H6
And then copy down:

And then we can put in column L:
=IF(ISNUMBER(MATCH(I6,$D$6:$D$16,0)),”MATCH”,”")

So when there is a match we between the item in Column I and Column D, we get the word “MATCH” appearing – otherwise we get blank space:

To download the .XLSX file for this article, click here

This is the opposite tutorial of the Converting a Single Row Vector into a Matrix tutorial.

The following function will take a range as a matrix and convert it to a single column vector:

Option Explicit
Function Create_Vector(Matrix_Range As Range) As Variant
Dim No_of_Cols As Integer, No_Of_Rows As Integer
Dim i As Integer
Dim j As Integer
Dim Cell
No_of_Cols = Matrix_Range.Columns.Count
No_Of_Rows = Matrix_Range.Rows.Count
ReDim Temp_Array(No_of_Cols * No_Of_Rows)
'Eliminate NULL Conditions
If Matrix_Range Is Nothing Then Exit Function
If No_of_Cols = 0 Then Exit Function
If No_Of_Rows = 0 Then Exit Function

For j = 1 To No_Of_Rows
    For i = 0 To No_of_Cols - 1
    Temp_Array((i * No_Of_Rows) + j) = Matrix_Range.Cells(j, i + 1)
    Next i
Next j
Create_Vector = Temp_Array
End Function

So for example the vector:

Will become:

Where we have used the following subroutine to print out the vector:

Private Sub CommandButton1_Click()
Dim Vector
Dim k As Integer
Vector = Create_Vector(Sheets("Sheet1").Range("A4:D8"))
For k = 1 To UBound(Vector)
        Sheets("Sheet1").Range("B20").Offset(k, 1).Value = Vector(k)
Next k
End Sub

Note that these routines work on both numbers and text.

To download the .XLSM file from this tutorial, click here.

Imagine that we have a list of names such as:

And we want to give each one a unique identifier:

So that the first name Bob has the identifier 1, and the next Mark has the identifier 2. This can be achieved by the following process.

We assign Bob (i.e the first person in the list) with an identifier 1:

And then we insert the following formulae in the next cell below this and copy down:

=IF(ISNA(MATCH(B7,B6:$B$6,0)),MAX(C6:$C$6)+1,VLOOKUP(B7,B6:$C$6,2,FALSE))

So:

The formulae works by looking for an occurrence of the name to date. If it doesn’t exist then it finds the maximum value of the identifier to date and adds one to give a new identifier. If a name does exist then a lookup is done to find the identifier for that name.

If more names are added at the bottom or in the middle and the formulae copies down, it still gives a distinct identifier.

Excel’s SUBSTITUTE function allows us to substitute part of a string with another part:

SUBSTITUTE(String,”Old Text”,”New Text”,occurrence”)

Where:
• String is the string that we are working with
• “Old Text” is the text that we want to eliminate
• “New Text” is the text that we want to incorporate
• Occurrence is which instance of the old text we wish to replace

Lets consider the following 3 examples:

Looking at cell B3, we want to replace the word “sick” with “large”. We can use the following expression:

=SUBSTITUTE(B3,”sick”,”large”,1)

If the text that we want to replace occurs more than once then we need to specify the instance that we mean. In the second example, we have two occurences of the word “old”. So if we want to change second instance to the word “grey” then we have to use:

=SUBSTITUTE(B4,”old”,”grey”,2)

Note that if the occurrence is not specified then all instances are replaced. So:

=SUBSTITUTE(B4,”old”,”grey”)

Would get rid of all instances of the word “old” and replace them with the word “grey”. Note that if the old text cannot be found then the string is unchanged. So looking at the last example:

=SUBSTITUTE(B5,”black”,”grey”,1)

Means that we try and replace the word “black” with the word “grey”. However, as “black” does not occur the original string remained unchanged:

To download the .XLSX file from this article, click here

This is the opposite tutorial of the Convert Matrix to Vector tutorial.

The following function takes a single row vector and converts into a matrix:

Function Create_Matrix(Vector_Range As Range, No_Of_Cols_in_output As Integer, No_of_Rows_in_output As Integer) As Variant
ReDim Temp_Array(No_Of_Cols_in_output, No_of_Rows_in_output)
Dim No_Of_Elements_In_Vector As Integer
Dim Col_Count As Integer, Row_Count As Integer
Dim Cell
No_Of_Elements_In_Vector = Vector_Range.Rows.Count
'Eliminate NULL Conditions
If Vector_Range Is Nothing Then Exit Function
If No_Of_Cols_in_output = 0 Then Exit Function
If No_of_Rows_in_output = 0 Then Exit Function
If No_Of_Elements_In_Vector = 0 Then Exit Function
For Col_Count = 1 To No_Of_Cols_in_output
    For Row_Count = 1 To No_of_Rows_in_output
    Temp_Array(Col_Count, Row_Count) = Vector_Range.Cells(((No_of_Rows_in_output) * (Col_Count - 1) + Row_Count), 1)
        Next Row_Count
Next Col_Count
Create_Matrix = Temp_Array
End Function

The function takes 3 arguments:
• The range of the initial vector
• The number of rows required in the matrix
• The number of columns required in the matrix

So if we have:

Then we can call our function:

Convert_to_matrix(c7:c16,2,5)

Where:

1. c7:c16 is the matrix range
2. 2 is the number of rows required in the matrix
3. 5 is the number of columns required

And we get:

To download the .XLSM file from this function, click here.

The following function will return the Maximum Value in each Column in a Range:

Function Max_Each_Column(Data_Range As Range) As Variant
    Dim TempArray() As Double, i As Long
        If Data_Range Is Nothing Then Exit Function
        With Data_Range
        ReDim TempArray(1 To .Columns.Count)
        For i = 1 To .Columns.Count
            TempArray(i) = Application.Max(.Columns(i))
        Next
    End With
        Max_Each_Column = TempArray
End Function

We can use a subroutine like the following to display the results:

Private Sub CommandButton1_Click()
Dim Answer As Variant
Dim No_of_Cols As Integer
Dim i As Integer
No_of_Cols = Range("B5:G27").Columns.Count
ReDim Answer(No_of_Cols)
Answer = Max_Each_Column(Sheets("Sheet1").Range("B5:g27"))

For i = 1 To No_of_Cols
MsgBox Answer(i)
Next i
End Sub

So:

Will return 990,907, 992, 976 ,988 and 873 for each of the above columns.
[SPECIAL THANKS TO MIKE RICKSON FOR RESOLVING THE FINERIES OF ARRAYS WITHIN UDF’S ]