Creating Word Clouds

We were working on a dashboard for one of our customer and had investigated the use of to generate word clouds for use in a dashboard. The site take a document and gives greater prominence to words that appear more often. In this sample we have used the last 4475 comment threads on our support forum to generate the above picture.

For a sales graphic it could be used to highlight the leading products or the most active customer or salesperson. For more information on dashboards you might be interested in attending our free workshops in the coming months


Excel / IE links not working

If you received this error after uninstalling Chrome (or Firefox) browser you may also need to change the HTM/HTML association in the registry.

1. Start, click Run, type Regedit in the Open box, and then click OK.
2. Browse to HKEY_CURRENT_USERSoftwareClasses.html
3. Right click the value for the .html key and select Modify…
4. Change the value from “ChromeHTML” to “htmlfile” (or from FireFoxHTML to htmlfile)
Repeat these steps for htm and .shtml keys if they exist.

Date Difference in Excel

I have used datediff in access and vba but didnt not know that excel had the function DateDif which is very useful function in pay budgeting models.

See the link here for details

Creating Excel files from MS Access

This routine is used to create an inventory forecast, which displays a 52 week forecast based on Sales orders MRP forecast and scheduled PO’s.

Function OpenWritetoXLS_QCS(tmpFiletoOpen, tmpFirstWeek, tmpLastWeek)
Dim objXL As Object
Dim strWhat As String, boolXL As Boolean
Dim objWkb As Object
Dim objSht As Object
Dim rst As Recordset, tmpRange, tmpRangeCount, tmpGonePast, tmpPosition, tmpOffset, I, tmpColumn
tmpGonePast = False
    Set rst = CurrentDb.OpenRecordset("Select * from tblTmpXLFile order by Id") ' this is my access table that contains the records I want to insert into excel
    If rst.RecordCount > 0 Then
        Set rst = Nothing
        MsgBox ("Nothing to export to excel")
        Exit Function
    End If
    tmpRange = ""

    If fIsAppRunning("Excel") Then
        Set objXL = GetObject(, "Excel.Application")
        boolXL = False
        Set objXL = CreateObject("Excel.Application")
        boolXL = True
    End If
    'now open file
  With objXL
    .Visible = True
    Set objWkb = .Workbooks.Open(tmpFiletoOpen)
    On Error Resume Next
    Set objSht = objWkb.Worksheets("SHEETNAME")
    If Not Err.Number = 0 Then
      Set objSht = objWkb.Worksheets.Add
      objSht.Name = "SHEETNAME"
    End If
    objXL.ActiveCell.offset(0, 0) = tmpFirstWeek
    On Error GoTo 0
    tmpRangeCount = 1
    With objSht
        Do While Not rst.EOF
            tmpPosition = rst!Cellref ' this notes the line within the Excel model that I want to populate
            'reset to new position
            Select Case tmpPosition
                Case 6
                    tmpOffset = 3
                Case 8
                    tmpOffset = 4
                Case 9
                    tmpOffset = 5
                Case 20
                    tmpOffset = 11
                Case 30
                    tmpOffset = 12
                Case 35
                    tmpOffset = 13
            End Select
            'Find out what row we should go to
            tmpColumn = Val(rst!rptLabel)
            tmpColumn = tmpColumn - tmpFirstWeek + 1
            If Val(rst!rptLabel) = 0 Then
                objXL.ActiveCell.offset(0, 0) = rst!FIELDNAME
                objXL.ActiveCell.offset(0, tmpColumn) = rst!FIELDNAME
            End If
    End With

  'update Parameters
    Set objSht = objWkb.Worksheets("Parameters")
    If Not Err.Number = 0 Then
      Set objSht = objWkb.Worksheets.Add
      objSht.Name = "Parameters"
    End If
    objXL.ActiveCell.offset(0, 0) = "Year"
    objXL.ActiveCell.offset(0, 1) = Forms![frmExport]![txtYear]
    objXL.ActiveCell.offset(1, 0) = "Overdue Week"
    objXL.ActiveCell.offset(1, 1) = Forms![frmExport]![txtOverDue]
    objXL.ActiveCell.offset(2, 0) = "Start of Month"
    objXL.ActiveCell.offset(2, 1) = Forms![frmExport]![txtStartofMonth]
    objXL.ActiveCell.offset(3, 0) = "First Week"
    objXL.ActiveCell.offset(3, 1) = Forms![frmExport]![txtFirstWeek]
    objXL.ActiveCell.offset(3, 0) = "Last Week"
    objXL.ActiveCell.offset(3, 1) = Forms![frmExport]![txtLastWeek]
  End With
  objWkb.Close savechanges:=True
  Set objSht = Nothing
  Set objWkb = Nothing
  Set objXL = Nothing
  Set rst = Nothing
End Function

Repeating a cell value in Excel

This is a request I have had a number of times.. In excel you want to copy the value of the cell above your current position if your current position is blank

To start this macro click on a row 2 or lower with a value in the cell above, change the value of x in the macro to the number of lines you want ot repeat

Sub Macro1()
' change the value of x to the number of lines to fill
Dim I, x
Do While I < x
    If ActiveCell.Value = "" Then
        ActiveCell.Offset(-1, 0).Select
        ActiveCell.Offset(1, 0).Select
    End If
    ActiveCell.Offset(1, 0).Select
    I = I + 1
End Sub

Adding Data from an excel file to Access

I wrote this macro to populate an access database with the contents from a protected spreadsheet that was distributed to users in different countries. The Excel file was used for Sales Order Entry. I have removed sections for security purposes, however this should serve as a good starting point for you to start your own version.

The idea is to ensure that the data integrity before loading the file and then marking the excel file as imported to prevent accidental duplication in the upload.

I have added comments to the code to explain the main sections, If you have any questions leave a comment.

'generic format

Sub XML_LoadXLTemplate()
' ExportData Macro
' Version 1.0 2-Apr-09
' Designed to export data to the xml data store
Dim tmpTest As Boolean, myfile, tmpStr, tmpFile, tmpPath, x, tmpCells, tmpCount, tmpShipName, tmpAPO
Dim rst As Recordset, db As Database, tmpCountry, tmpEntity, tmpODate, tmpOrderRef, tmpShip5, tmpShip6
Dim tmpShip1, tmpShip2, tmpShip3, tmpShip4, tmpArea, tmpWH, tmpPriceList, tmpStartSheet, tmpShipDate
Dim tmpFailures, rstStock As Recordset, tmpRequestor
Dim tmpPhone, tmpEmail, tmpAttention, tmpWarranty, tmpCrystal, tmpShipVia, tmpShipViaAccount

'|need to set a reference to DAO , under tools
'|references Microsoft DAO 3.6...

Set db = OpenDatabase("\serverYouDatabase.mdb")
Set rst = db.OpenRecordset("tblImportData")

tmpTest = True
tmpStr = ""

Application.ScreenUpdating = False
tmpStartSheet = ActiveSheet.Name

' This cell is populated after the data is imported to ensure the user does not accidentally duplicate the load

If ActiveCell.Value = "Data Imported" Then
    If MsgBox("This sheet has already been imported, Import Again ?", vbYesNo + vbDefaultButton2) = vbNo Then
        Exit Sub
    End If
End If


If FoundWS("SheetName") = False Then  ' FOR FUNCTION SEE
    MsgBox "Cannot find the Order Sheet SheetName"
    Exit Sub
End If


'now check the control cells
tmpFailures = ""

If Len(ActiveCell.Value & "") = 0 Then
    tmpFailures = tmpFailures & "This Order must Contain the Entity Code at D6" & vbCrLf
End If

If Len(ActiveCell.Value & "") = 0 Then
    tmpFailures = tmpFailures & "No Entity name entered at D7 " & vbCrLf
End If
' you can add as many checks to the integrity of the sheet before starting the load

'now check the order lines
i = 1
Do While i < 86 ' I had max 86 lines to validate
    If ActiveCell.Offset(0, 7).Value > 0 Then
        If Len(ActiveCell.Offset(0, 1).Value & "") = 0 Then
            tmpFailures = tmpFailures & "Order Line #" & i & " No part number entered" & vbCrLf
        End If
    End If
    i = i + 1
    ActiveCell.Offset(1, 0).Select

If Len(tmpFailures & "") > 0 Then
    MsgBox "Order Validation Failed " & vbCrLf & vbCrLf & tmpFailures
    Exit Sub
End If

'now move to the first line defined by A2


'set the variables

tmpEntity = ActiveCell.Value
tmpCountry = ActiveCell.Offset(1, 0).Value
tmpShipName = ActiveCell.Offset(3, 0).Value
tmpShip1 = ActiveCell.Offset(4, 0).Value
tmpShip2 = ActiveCell.Offset(5, 0).Value
tmpShip3 = ActiveCell.Offset(6, 0).Value
tmpShip4 = ActiveCell.Offset(7, 0).Value
tmpShip5 = ActiveCell.Offset(8, 0).Value
tmpShip6 = ActiveCell.Offset(9, 0).Value
tmpAttention = ActiveCell.Offset(10, 0).Value
tmpPhone = ActiveCell.Offset(11, 0).Value
tmpEmail = ActiveCell.Offset(12, 0).Value

tmpCells = 28

'move to the start
Cells(tmpCells, 1).Select

'check the value in a1 & h1 is numeric
Do While tmpCount < 86
    If ActiveCell.Offset(0, 7).Value > 0 Then
        'Add the contents to the database
        With rst
            !O_Entity = tmpEntity
            !O_Date = tmpODate
            !O_Part = ActiveCell.Offset(0, 1).Value
            !O_PartOrg = ActiveCell.Offset(0, 1).Value
            '!O_AltPart = ActiveCell.Offset(0, 2).Value
            !O_Desc = Left(ActiveCell.Offset(0, 3).Value, 200)
            !O_qty = ActiveCell.Offset(0, 7).Value
            !O_price = ActiveCell.Offset(0, 9).Value
            !O_Price2 = 0 'ActiveCell.Offset(0, 9).Value
            !O_Extended = !O_qty * !O_price 'ActiveCell.Offset(0, 7).Value
            !O_ImpDate = Now()
            !O_LineShipDate = IIf(Len(ActiveCell.Offset(0, 7).Value & "") = 0, tmpShipDate, ActiveCell.Offset(0, 7).Value)
            !O_OrderDate = tmpODate
            !O_Ship1 = tmpShip1
            !O_Ship2 = tmpShip2
            !O_Ship3 = tmpShip3
            !O_Ship4 = tmpShip4
            !O_Ship5 = tmpShip5
            !O_Ship6 = Left(tmpShip6, 9)
            !O_ShipName = tmpShipName
            !O_Phone = tmpPhone
            !O_EmailAddress = tmpEmail
            !O_Crystalid = tmpCrystal
            !O_Warranty = tmpWarranty
            !O_ShipVia = tmpShipVia & " " & tmpShipViaAccount
            !O_Requestor = tmpRequestor
            !O_Attention = tmpAttention
            !O_Text = 1
            !O_Warehouse = ""
            !O_Number = tmpOrderRef & "-" & !O_Warehouse

            Set rstStock = Nothing

            !O_PriceList = "A"

        End With
    End If
    ActiveCell.Offset(1, 0).Select
    tmpCount = tmpCount + 1

MsgBox "Database updated"

End Sub

Using Vlookup in Excel files

excelisna1When using the Vlookup or HLookup functions in Excel you will sometimes have #N/A in the cell display as the value cannot be found.

The normal syntax a user would enter in B9 would be VLOOKUP(A9,$A$2:$C$4,2,FALSE) to lookup the value of A9 in the list A2:C4, because the item exists the function returns the value.

In cell B10 the part BD12 does not exist and you get the error #N/A, replace the cell formula with IF(ISNA(VLOOKUP(A14,$A$2:$C$4,2,FALSE)),”None Found”,VLOOKUP(A14,$A$2:$C$4,2,FALSE)) as shown in B14.

In this case I have entered “Not Found” if the value does not exist and in C14  I entered 0.