Creating Word Clouds

We were working on a dashboard for one of our customer and had investigated the use of http://www.wordle.net/ 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 http://e-ms.ie/excel-dashboard-workshop/

 

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
        rst.MoveFirst
    Else
        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
    Else
        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
    
    objWkb.Worksheets("SHEETNAME").Activate
    
    objSht.Range("C1").Select
    objXL.ActiveCell.offset(0, 0) = tmpFirstWeek
    
    Err.Clear
    
    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
                    .Range("B4").Select
                    tmpOffset = 3
                Case 8
                    .Range("B5").Select
                    tmpOffset = 4
                Case 9
                    .Range("B6").Select
                    tmpOffset = 5
                Case 20
                    .Range("B12").Select
                    tmpOffset = 11
                Case 30
                    .Range("B13").Select
                    tmpOffset = 12
                Case 35
                    .Range("B14").Select
                    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
            Else
                objXL.ActiveCell.offset(0, tmpColumn) = rst!FIELDNAME
            End If
            rst.MoveNext
        Loop
    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
    
    objWkb.Worksheets("Parameters").Activate
    
    objSht.Range("A1").Select
    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
x=1500
Do While I < x
    If ActiveCell.Value = "" Then
        ActiveCell.Offset(-1, 0).Select
        Selection.Copy
        ActiveCell.Offset(1, 0).Select
        ActiveSheet.Paste
    End If
    ActiveCell.Offset(1, 0).Select
    I = I + 1
Loop
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

Range("I1").Select
' 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

Range("A1").Select

If FoundWS("SheetName") = False Then  ' FOR FUNCTION SEE http://www.ozgrid.com/forum/showthread.php?t=38108
    MsgBox "Cannot find the Order Sheet SheetName"
    Exit Sub
End If

Sheets("SheetName").Select

'now check the control cells
tmpFailures = ""

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

Range("D7").Select
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
Range("a28").Select
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
Loop

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

Range("d6").Select

'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

Range("A28").Select
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
            .AddNew
            !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"

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

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.