Editing a NK2 files

May 30

This is so random that I had to include this here

Every time that you type an email address or name in the message window of MS-Outlook, it automatically offer you a list of users and email address that you can choose. This feature is known as ‘AutoComplete’ and Outlook automatically build this emails list according to user activity and save it into a file with .NK2 extension.

This site has a free utility to edit these addresses


Consolidate the contents of multiple excel sheets

Apr 30

This is a very useful macro to add the contents of several excel sheets onto a single sheet

Sub CopyFromWorksheets()
    Dim wrk As Workbook 'Workbook object - Always good to work with object variables
    Dim sht As Worksheet 'Object for handling worksheets in loop
    Dim trg As Worksheet 'Master Worksheet
    Dim rng As Range 'Range object
    Dim colCount As Integer 'Column count in tables in the worksheets

    Set wrk = ActiveWorkbook 'Working in active workbook

    For Each sht In wrk.Worksheets
        If sht.Name = "Master" Then
            MsgBox "There is a worksheet called as 'Master'." & vbCrLf & _
            "Please remove or rename this worksheet since 'Master' would be" & _
            "the name of the result worksheet of this process.", vbOKOnly + vbExclamation, "Error"
            Exit Sub
        End If
    Next sht 
     'We don't want screen updating
    Application.ScreenUpdating = False 
     'Add new worksheet as the last worksheet
    Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count))
     'Rename the new worksheet
    trg.Name = "Master"
     'Get column headers from the first worksheet
     'Column count first
    Set sht = wrk.Worksheets(1)
    colCount = sht.Cells(1, 255).End(xlToLeft).Column
     'Now retrieve headers, no copy&paste needed
    With trg.Cells(1, 1).Resize(1, colCount)
        .Value = sht.Cells(1, 1).Resize(1, colCount).Value
         'Set font as bold
        .Font.Bold = True
    End With 
     'We can start loop
    For Each sht In wrk.Worksheets
         'If worksheet in loop is the last one, stop execution (it is Master worksheet)
        If sht.Index = wrk.Worksheets.Count Then
            Exit For
        End If
         'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets
        Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount))
         'Put data into the Master worksheet
        trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
    Next sht
     'Fit the columns in Master worksheet
     'Screen updating should be activated
    Application.ScreenUpdating = True
End Sub

Rounded corners in an Access report

Mar 30

Here is a useful function which Duane Hookom MVP had on on of the blogs

It allows you to add nice rounded boxes to your reports for addresses for example

Sub RoundCornerBox( _
        lngWidth As Long, _
        lngHeight As Long, _
        lngTop As Long, _
        lngLeft As Long, _
        lngRadius As Long, _
        rptReport As Report)
    'call this from a report with syntax like
    'Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
    '    RoundCornerBox 4000, 6000, 100, 200, 300, Me
    'End Sub

    Dim sngStart As Single
    Dim sngEnd As Single
    Dim dblPI As Double
    dblPI = 3.14159265359
    rptReport.DrawWidth = 15
    'Top Left
    sngStart = 2 * dblPI * 0.25 ' Start of pie slice.
    sngEnd = 2 * dblPI * 0.5    ' End of pie slice.
    rptReport.Circle (lngLeft + lngRadius, _
            lngTop + lngRadius), _
            lngRadius, vbBlack, sngStart, sngEnd
    'Top line
    rptReport.Line (lngLeft + lngRadius, lngTop)- _
        (lngLeft + lngWidth - lngRadius, lngTop)
    'Top Right
    sngStart = 2 * dblPI * 0.000001
    sngEnd = 2 * dblPI * 0.25
    rptReport.Circle (lngLeft + lngWidth - _
            lngRadius, lngTop + lngRadius), _
            lngRadius, vbBlack, sngStart, sngEnd
    'right line
    rptReport.Line (lngLeft + lngWidth, _
        lngTop + lngRadius)- _
        (lngLeft + lngWidth, _
        lngTop + lngHeight - lngRadius)
    'Bottom right
    sngStart = 2 * dblPI * 0.75
    sngEnd = 2 * dblPI
    rptReport.Circle (lngLeft + lngWidth - _
        lngRadius, lngTop + lngHeight - lngRadius), _
        lngRadius, vbBlack, sngStart, sngEnd
    rptReport.Line (lngLeft + lngRadius, _
        lngTop + lngHeight)- _
        (lngLeft + lngWidth - lngRadius, lngTop + lngHeight)
    'Bottom Left
    sngStart = 2 * dblPI * 0.5
    sngEnd = 2 * dblPI * 0.75
    rptReport.Circle (lngLeft + lngRadius, _
        lngTop + lngHeight - lngRadius), _
        lngRadius, vbBlack, sngStart, sngEnd
    'right line
    rptReport.Line (lngLeft, lngTop + lngRadius)- _
        (lngLeft, lngTop + lngHeight - lngRadius)
End Sub

Locked File

Feb 21

This function from the MS site was useful to ensure the file was available before been processed

Function FileLocked(strFileName As String) As Boolean
   On Error Resume Next
   ' If the file is already opened by another process,
   ' and the specified type of access is not allowed,
   ' the Open operation fails and an error occurs.
   Open strFileName For Binary Access Read Write Lock Read Write As #1
   Close #1
   ' If an error occurs, the document is currently open.
   If Err.Number <> 0 Then
      ' Display the error number and description.
      Application.Echo True, "Error #" & str(Err.Number) & " - " & Err.Description
      FileLocked = True
   End If
End Function

Julian Date to Access Dates

Oct 01

A useful function from the microsoft site

Function CJulian2Date (JulDay As Integer, Optional YYYY)
    If IsMissing(YYYY) Then YYYY = Year(Date)
    If Not IsNumeric(YYYY) Or YYYY \ 1 <> YYYY Or YYYY < 100 Or YYYY  > 9999 Then Exit Function
    If JulDay > 0 And JulDay < 366 Or JulDay = 366 And  YYYY Mod 4 = 0 And YYYY Mod 100 <> 0 Or YYYY Mod 400 = 0 Then 
        CJulian2Date = Format(DateSerial(YYYY, 1, JulDay), "m/d/yyyy")
End Function

Rounding up to a factor

Sep 28

I found this function today ( its been around since 99) , its rounds up or down to your specified rounding amount.

For example round 2.64 upwards to the nearest .1 would = 2.7

Or 12.34 upward to the nearest 5 would = 15

Function Rnd2Num(Amt As Variant, RoundAmt As Variant, Direction As Integer) As Double
'From: Arvin Meyer Newsgroups: <a href="http://comp.databases.ms/" target="_blank">comp.Databases.ms</a> -Access
'Date: 1999/04/21

On Error Resume Next
Dim Temp As Double, rnddown
rnddown = 0
Temp = Amt / RoundAmt
If Int(Temp) = Temp Then
    Rnd2Num = Amt
    If Direction = rnddown Then
       Temp = Int(Temp)
       Temp = Int(Temp) + 1
    End If
    Rnd2Num = Temp * RoundAmt
End If
End Function
Function testround()
    MsgBox Rnd2Num(2.64, 0.1, 1)
End Function

QR Codes

Aug 01

We are seeing QR Codes in our newspapers, handouts and trade shows to allow smartphone users to scan the url or related information.

This QR Code for example contains all my contact information and can be scanned by certain barcode scanners and smartphones using free apps and your phones camera.

You can create your own here http://qrcode.kaywa.com/ for more information checkout Wikipedia http://en.wikipedia.org/wiki/QR_code

Recording your PC Screen

Apr 20

Have you ever wanted to create a tutorial to record how something should be done on a PC. Well, here is a handy little utility program which will do it.

To aid their development of Windows 7 beta versions, the Microsoft engineers built in a diagnostic tool called Problem Steps Recorder that combines screen captures with mouse tracking to record your actions. You can launch this program from the Start Menu by typing psr.exe in the search field. Hit the Record button and the applet tracks your mouse and keyboard input while taking screen shots that correspond with each new action. When you stop recording, your session is saved to an HTML slide show recreating your steps. You can add comments and annotations.

This tool is instantly useful if you need to create a tutorial, for example, to provide instruction for anyone on how to run an application.

Printing comments on an excel sheet

Feb 24

Select File page Setup
Select the Sheet option
Beside comments select “As Displayed on Sheet”

Changing the System Date with VBA

Feb 23

I needed to reload files into an access database and process the contents based on the system date. To avoid having to process each file manually, I found that you can change the system date of the computer with this vba code

Date= #23-Feb-2011#

And you can also set the time , a bit too easy !

If you need some help on a project drop leave a comment on the post and I will reply.