Monday, August 27, 2012

Counting Unique Values in a Range

Nice and simple but effective, this formula counts how many unique items there are in a range.

Where Range A1:B10 contains the data


Sun April
Mon Mon
Tue Tue
Wed Wed
Thu May
Fri Fri
Sat Sat
Sun Sun
Mon Mon
Jun Tue


=SUMPRODUCT(($A$1:$B$11<>"")/COUNTIF($A$1:$B$11,$A$1:$B$11&"")) = 10

Monday, August 20, 2012

Check whether a cell contains a specific string

When working with folders, I find a handy formula to have is one that can identify a string within a larger string. For example the following data is used to determine whether the folder path was for office or factory staff and then route a save procedure accordingly:

Where A1 contains
London\Office\Bloggs, Joe

=IF(ISNUMBER(SEARCH("Office",A1)),"Office")  = Office

Where you have multiple locations that could appear, use a nested formula

Where A1 contains
London\Factory\Smith, Mary

=IF(ISNUMBER(SEARCH("Office",A2)),"Office",IF(ISNUMBER(SEARCH("Factory",A2)),"Factory")) = Factory

Monday, July 30, 2012

Validating Start and End Dates

I'm often using date specific queries to manage reports in excel and have found it handy to validate the start and end date to make sure that I'm entering the right thing !

Following the module using the date function : in this case I'm using the variables FromDate and ToDate


Public Sub GetValidDates(ByRef FromDate As Date, _
                         ByRef ToDate As Date, _
                         Optional MinDate As Date, _
                         Optional MaxDate As Date)
    Dim bError As Boolean
    Dim sErrorMessage As String
    Dim vMyStart As Variant, vMyEnd As Variant

    '----------------------------------------------------------------------------
    ' Code below taken with advice from
    ' http://www.mrexcel.com/forum/showthread.php?t=274520
    '----------------------------------------------------------------------------

    vMyStart = ""
    vMyEnd = ""
    Do
        bError = False
        sErrorMessage = ""
        vMyStart = Application.InputBox(Prompt:="Enter Month Start date (dd/mm/yy)", _
                                             Title:="Start Date", _
                                             Default:=vMyStart)

        If IsDate(vMyStart) = False Then
            bError = True
            vMyStart = ""
            sErrorMessage = "Start date not a date"
        Else
            If CheckDateInRange(Datex:=vMyStart, _
                                MinDate:=MinDate, _
                                MaxDate:=MaxDate) = False Then
                bError = True
                sErrorMessage = "Month start Date is not in range"
                vMyStart = ""
            End If

            If bError = False Then
                vMyEnd = Application.InputBox(Prompt:="Enter Month End date (dd/mm/yy)", _
                                                   Title:="End Date", _
                                                   Default:=vMyEnd)
                If IsDate(vMyEnd) = False Then
                    bError = True
                    sErrorMessage = "End date is not a date"
                    vMyEnd = ""
                End If
            End If

            If bError = False Then
                If CheckDateInRange(Datex:=vMyEnd, _
                                    MinDate:=MinDate, _
                                    MaxDate:=MaxDate) = False Then
                    bError = True
                    sErrorMessage = "End Date is not in range"
                    vMyEnd = ""
                End If
            End If

            If vMyEnd < vMyStart Then
                bError = True
                sErrorMessage = "Start Date not before End date"
                vMyEnd = ""
            End If

        End If
        If bError Then MsgBox Prompt:=sErrorMessage, Buttons:=vbOKOnly + vbCritical, Title:="Invalid Date!"
    Loop While bError

    FromDate = CDate(vMyStart)
    ToDate = CDate(vMyEnd)
End Sub
Private Function CheckDateInRange(ByVal Datex As Variant, _
                                  Optional MinDate As Date, _
                                  Optional MaxDate As Date) As Boolean
'----------------------------------------------------------------------------
' Return False if specified date is not in range
'----------------------------------------------------------------------------
    Dim datCur As Date

    On Error GoTo labError
    datCur = CDate(Datex)
    If Not (IsMissing(MinDate)) Then
        If datCur < MinDate Then
            CheckDateInRange = False
            Exit Function
        End If
    End If

    If Not (IsMissing(MaxDate)) Then
        If datCur > MaxDate Then
            CheckDateInRange = False
            Exit Function
        End If
    End If

    CheckDateInRange = True
    Exit Function

labError:
    CheckDateInRange = False
End Function



Monday, July 16, 2012

Adding up totals dependant on flags

There has been an occasion where I have need to add up entries from a list depending if a certain condition has been met. In this occasion it was adding up which hours were overtime or not. In this case I ended the overtime hours with a £

Where A1:A5 data equals


2



{=SUM(1*IF(RIGHT(A$1:A$5,1)="£",MID(A$1:A$5,2,LEN(A$1:A$5)-2),0))} = 5

*note
This is an array formula so use Ctrl Shift & Enter to add curly brackets

Monday, July 2, 2012

Adding and Calculating with Dates

If you want to find out what the date would be in X days/months/years time then this formula can help.

Where
A1 = 01/01/2012

=DATE(YEAR(A1),MONTH(A1),DAY(A1)+1) = 02/01/12
=DATE(YEAR(A1),MONTH(A1)+1,DAY(A1)) = 01/02/12
=DATE(YEAR(A1)+1,MONTH(A1),DAY(A1)) = 01/01/13

Simply add in a cell reference for the days/months/years to add and this is a very powerful formula

Monday, June 18, 2012

Splitting Text Strings

One of the most useful and, sometimes, the trickiest formulas to figure out involve spitting text strings. So here are some handy formulas :

Where A1 contains Brad Pitt

=LEFT(A1,SEARCH(" ",A1)-1) = Brad

=TRIM(MID(A1,FIND(" ",A1),LEN(A1)-1)) = Pitt

=CONCATENATE(LEFT(A1,1)," ",TRIM(MID(A1,FIND(" ",A1),LEN(A1)-1))) = B Pitt



And if Brad had a middle name then there would need to be something a little more complicated :

Where A1 contains Brad Stanley Pitt

 =RIGHT(A1,LEN(A1)-FIND("#",SUBSTITUTE(A1," ","#",LEN(A1)-LEN(SUBSTITUTE(A1," ",""))))) = Pitt

=LEFT(RIGHT(A1,LEN(A1)-FIND(" ",A1,1)),FIND(" ",RIGHT(A1,LEN(A1)-FIND(" ",A1,1)),1)) = Stanley




And if Brad had an email that we wanted to split the details from then :

Where A1 contains Brad.Pitt@Gmail.com

=LEFT(A1,SEARCH(".",A1)-1) = Brad

=MID(A1,SEARCH(".",A1)+1,SEARCH("@",A1)-SEARCH(".",A1)-1) = Pitt

=LEFT(A1,SEARCH(".",A1)-1)&" "&MID(A1,SEARCH(".",A1)+1,SEARCH("@",A1)-SEARCH(".",A1)-1) = Brad Pitt


More quirky ways :

Where A1 contains Pitt, Brad

=LEFT(TRIM(MID(SUBSTITUTE(A1,",",REPT(" ",50)),50,50)))&" "&LEFT(A1,FIND(",",A1)-1) = B Pitt



Wednesday, June 6, 2012

Working out the End of the Month

There's a lot of times when it's useful to know the end of the month problematically, especially when the start date can change. Some examples :

Note: Make sure that Tools -> Analysis Toolpack is ticked.

Where A1 = 05/01/2012

=EOMONTH(A1,0) = 31/01/2012
=EOMONTH(A36,5) = 30/06/2012 (adding 5 months to the end of the month)
=EOMONTH(A38,-1) = 31/12/2011 (minus works too)



Monday, May 21, 2012

Calculating between dates

Calculating with dates is always tricky. Here's a neat formula that spells it out !

Where
A1 = 01/01/2012
A2 = 21/05/2012

=DATEDIF(A1,A2,"y")&" years "&DATEDIF(A1,A2,"ym")&" months "&DATEDIF(A1,A2,"md")&" days"

Gives the result : 0 years 4 months 20 days

Monday, May 7, 2012

Code for email via Lotus Notes

A quick module to send an email via Lotus Notes from Excel

Option Explicit
Sub BasicEmailSend()
'----------------------------------------------------------------------------
'Users MUST have their Lotus Notes open and running user information is taken from the logon for security purposes
'----------------------------------------------------------------------------
    On Error GoTo notesIsNotRunning
    AppActivate ("Notes")       'tries to active notes
    AppActivate "Microsoft Excel"
    GoTo LotusOk

notesIsNotRunning:        ' If lotus is not working then give an error message
    Dim notesErr, notesBox

LotusOk:
    On Error GoTo 0
    '----------------------------------------------------------------------------
    'Create email settings
    '----------------------------------------------------------------------------
    Dim session, Maildb, MailDoc, attachME1, EmbedObj1 As Object
    Dim name_string, Username, MyMailText, MailText, MailDbName As String
    Dim myAttachement, EmailAddress1, EmailAddress2, EmailAddress3, Recipient, ccRecipient, cuser As String
    Dim continue As Variant

    Set session = CreateObject("Notes.NotesSession")
    Username = session.Username
    MailDbName = Left$(Username, 1) & Right$(Username, (Len(Username) - InStr(1, Username, " "))) & ".nsf"
    Set Maildb = session.GetDatabase("", MailDbName)
    If Not Maildb.IsOpen Then Maildb.OpenMail
    Set MailDoc = Maildb.CREATEDOCUMENT

    EmailAddress1 = Sheets("Sheet1").Range("B1")
    EmailAddress2 = Sheets("Sheet1").Range("B2")
    EmailAddress3 = Sheets("Sheet1").Range("B3")

    Recipient = Array(EmailAddress1, EmailAddress2)
    ccRecipient = Array(EmailAddress3)

    '----------------------------------------------------------------------------
    'Set the email type, optional body text and subject etc...
    '----------------------------------------------------------------------------
    MyMailText = InputBox("Please enter text to send with email?" & vbCrLf & vbCrLf & "Click OK to send without comment")
    Select Case MyMailText
    Case ""
        MailText = "This is a comment that is hard coded and is changed via VBA"
    Case Else
        MailText = MyMailText
    End Select

    With MailDoc
        .Form = "Memo"
        .ReturnReceipt = "1"
        .Subject = "This is a test of the excel to Lotus code"
        MailDoc.Sendto = Recipient
        MailDoc.CopyTo = ccRecipient
        .body = Replace(MailText, "@", vbCrLf)
        .postdate = Date
        .SaveMessageOnSend = True
    End With

    '----------------------------------------------------------------------------
    'Set the directory and file path for the attachment
    'This example will save this file to the c drive and email
    '----------------------------------------------------------------------------
    ChDir "C:\"
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:="C:\Test.xls"
    myAttachement = "C:\Test.xls"
    Application.DisplayAlerts = True

    '----------------------------------------------------------------------------
    'Putting the email together and sending
    '----------------------------------------------------------------------------
    Dim charcount As Long
    Dim FirstChar, LastChar As String

    Set attachME1 = MailDoc.CREATERICHTEXTITEM("myAttachement")
    Set EmbedObj1 = attachME1.EmbedObject(1454, "", myAttachement)
    MailDoc.PostedDate = Now
    Call MailDoc.send(False)

    Set session = CreateObject("Notes.NotesSession")
    name_string = session.Username
    For charcount = 1 To Len(name_string)
        If Mid(name_string, charcount, 1) = "=" Then FirstChar = charcount + 1
        If Mid(name_string, charcount, 1) = "/" Then
            LastChar = charcount - 1
            charcount = Len(name_string) + 1
        End If
    Next
    Username = Mid(name_string, FirstChar, LastChar - FirstChar + 1)
    cuser = Split(Username, " ")(0)
    continue = MsgBox("Message sent successfully.", vbOKOnly, "Thank You - " & cuser)

    '----------------------------------------------------------------------------
    'Optional delete uploaded file users system and hides sheets
    '----------------------------------------------------------------------------
    'Kill myAttachement
    End

End Sub