Posts tagged ‘Excel VBA’

May 14th, 2012

VBA – Read File into Memory

The following function enable you to read in, for instance a text file, into memory to use within your routines.

'---------------------------------------------------------------------------------------
' Procedure : ReadFile
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Faster way to read text file all in RAM rather than line by line
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
' Input Variables:
' ~~~~~~~~~~~~~~~~
' strFile - name of the file that is to be read
'
' Usage Example:
' ~~~~~~~~~~~~~~~~
' MyTxt = ReadText("c:\tmp\test.txt")
' MyTxt = ReadText("c:\tmp\test.sql")
' MyTxt = ReadText("c:\tmp\test.csv")
'---------------------------------------------------------------------------------------
Function ReadFile(ByVal strFile As String) As String
On Error GoTo Error_Handler
    Dim FileNumber  As Integer
    Dim sFile       As String 'Variable contain file content

    'If FileExist(strFile) = False Then
    '    MsgBox "The specified file could not be found!"
    '    Exit Function
    'End If
    
    FileNumber = FreeFile
    Open strFile For Binary Access Read As FileNumber
    sFile = Space(LOF(FileNumber))
    Get #FileNumber, , sFile
    Close FileNumber
 
    ReadFile = sFile
 
Error_Handler_Exit:
    On Error Resume Next
    Exit Function
 
Error_Handler:
    MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
            "Error Number: " & Err.Number & vbCrLf & _
            "Error Source: ReadFile" & vbCrLf & _
            "Error Description: " & Err.Description, _
            vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit
End Function

c

June 4th, 2011

VBA – VBE Enumerate Modules, Procedures and Line Count

It still amazes me how Microsoft can develop these complexe applications but seems to overlook some simple functions that they should included within them to aid developers… But then, as demonstrated with the release of Office 2007 and 2010, Microsoft is not interested in the developer, they are only interested in the end-user’s opinion. Not productivity (that went down, about 30-40% drop in efficiency, the tubes with their change of format)! So all that matters is looks, the feel – very superficial (rant over)!!!

This will be the first in a series of procedure that I will be posting in the coming months in which I hope to demonstrate how you can use the ‘Microsoft Visual Basic for Application Extensibility’ library in conjuntion with the power of VBA to learn more, control more, manipulate more the VBE.

In this first post, I simply wanted to create a simple procedure that would give me a breakdown of my Access project. I wanted to return a listing of procedure per module with a line count. As you can see, the ‘Microsoft Visual Basic for Application Extensibility’ enable us to perform this task with ease with little code. Heck, half of the code below is to write to the generated text file!

'---------------------------------------------------------------------------------------
' Procedure : GetVBEDeatils
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Goes throught the VBE and creates a text file which give a brief listing
'             of the procedures within each module and a line count for each
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
' Requirements: reference to the Microsoft Visual Basic for Application Extensibility
'               library.
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2011-June-04            Initial Release
'---------------------------------------------------------------------------------------
Function GetVBEDeatils()
    Dim vbProj          As VBProject
    Dim vbComp          As VBComponent
    Dim vbMod           As CodeModule
    Dim sProcName       As String
    Dim pk              As vbext_ProcKind
    Dim FileNumber      As Integer
    Dim strFile         As String
    Const vbNormalFocus = 1
 
    'Where do youwant the text file created
    strFile = "C:\VBEDetails.txt"
    If Len(Dir(strFile)) > 0 Then Kill strFile
    FileNumber = FreeFile                           'Get unused file number.
    Open strFile For Append As #FileNumber          'Create file name.
        
    For Each vbProj In Application.VBE.VBProjects   'Loop through each project
        Print #FileNumber, vbProj.Name
        For Each vbComp In vbProj.VBComponents      'Loop through each module
            Set vbMod = vbComp.CodeModule
            Print #FileNumber, "   " & vbComp.Name & " :: " & vbMod.CountOfLines & " total lines"
            Print #FileNumber, "   " & String(80, "*")
            iCounter = 1
            Do While iCounter < vbMod.CountOfLines  'Loop through each procedure
                sProcName = vbMod.ProcOfLine(iCounter, pk)
                If sProcName <> "" Then
                    Print #FileNumber, "      " & sProcName & " :: " & vbMod.ProcCountLines(sProcName, pk) & " lines"
                    iCounter = iCounter + vbMod.ProcCountLines(sProcName, pk)
                Else
                    iCounter = iCounter + 1
                End If
            Loop
            Print #FileNumber, ""
        Next vbComp
    Next vbProj
 
    Close #FileNumber                               'Close file.
    Set vbMod = Nothing
 
    'Open the generated text file
    Shell "cmd /c """ & strFile & """", vbNormalFocus
End Function

March 26th, 2011

MS Excel – VBA – Find Cells with Linked Data

Have you ever had the pleasure of being given a workbook and when you open it it spits out the error:

Workbook contains one or more links that connot be updated.

To change the source of links, or attempt to update values again, click Edit Links.
To leave the links as is, click Continue

What really is annoying is that MS give the user no way to determine which cells are using the linked data, so no way for you to determine if and what to do! (Another poorly implemented aspect of an MS program). Below is a simple procedure that will create a worksheet where it will list each cell in each worksheet that used Linked Data as well as the source of the linked data.

Sub ShowAllLinksInfo()
'Author:        JLLatham
'Purpose:       Identify which cells in which worksheets are using Linked Data
'Requirements:  requires a worksheet to be added to the workbook and named LinksList
'Modified From: http://answers.microsoft.com/en-us/office/forum/office_2007-excel/workbook-links-cannot-be-updated/b8242469-ec57-e011-8dfc-68b599b31bf5?page=1&tm=1301177444768
    Dim aLinks           As Variant
    Dim i                As Integer
    Dim Ws               As Worksheet
    Dim anyWS            As Worksheet
    Dim anyCell          As Range
    Dim reportWS         As Worksheet
    Dim nextReportRow    As Long
    Dim shtName          As String
 
    shtName = "LinksList"
 
    'Create the result sheet if one does not already exist
    For Each Ws In Application.Worksheets
        If Ws.Name = shtName Then bWsExists = True
    Next Ws
    If bWsExists = False Then
        Application.DisplayAlerts = False
        Set Ws = ActiveWorkbook.Worksheets.Add(Type:=xlWorksheet)
        Ws.Name = shtName
        Ws.Select
        Ws.Move After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count)
        Application.DisplayAlerts = True
    End If
 
    'Now start looking of linked data cells
    Set reportWS = ThisWorkbook.Worksheets(shtName)
    reportWS.Cells.Clear
    reportWS.Range("A1") = "Worksheet"
    reportWS.Range("B1") = "Cell"
    reportWS.Range("C1") = "Formula"
 
    aLinks = ActiveWorkbook.LinkSources(xlExcelLinks)
    If Not IsEmpty(aLinks) Then
        'there are links somewhere in the workbook
        For Each anyWS In ThisWorkbook.Worksheets
            If anyWS.Name <> reportWS.Name Then
                For Each anyCell In anyWS.UsedRange
                    If anyCell.HasFormula Then
                        If InStr(anyCell.Formula, "[") > 0 Then
                            nextReportRow = reportWS.Range("A" & Rows.Count).End(xlUp).Row + 1
                            reportWS.Range("A" & nextReportRow) = anyWS.Name
                            reportWS.Range("B" & nextReportRow) = anyCell.Address
                            reportWS.Range("C" & nextReportRow) = "'" & anyCell.Formula
                        End If
                    End If
                Next    ' end anyCell loop
            End If
        Next    ' end anyWS loop
    Else
        MsgBox "No links to Excel worksheets detected."
    End If
    'housekeeping
    Set reportWS = Nothing
    Set Ws = Nothing
End Sub

I can’t take credit for this procedure, but thought it was the type of thing that could help a lot of people. The original source/post is provided should you wish to check it out further.