Solved

Excel VBA Hash of All Formulas and VBA

Posted on 2011-03-01
17
1,012 Views
Last Modified: 2012-05-11
I have a bunch of Excel files with formulas and VBA scripts. I do not mind if the values in the spreadsheets are different, but I want to make sure that all of the formulas and VBA scripts are identical. Is there a way in VBA that I can compute a hash of all the workbook formulas and scripts? That way, if the hash of the different workbooks are the same, I know that all of the calculation steps are the same, even if the values are different. Thanks.
0
Comment
Question by:sypder
  • 6
  • 4
  • 3
  • +2
17 Comments
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35013165
sypder, I have never worked with Hash but when it comes to VBA scripts, please consider the below scripts. They both are same but will they not generate different Hash?

Sub Sample
msgbox "a"
End Sub

Open in new window


Sub Sample
'~~> This is a message box
msgbox "a"
End Sub

Open in new window


Sid
0
 
LVL 3

Author Comment

by:sypder
ID: 35013274
Yes, they are the same but would generate different hashes. This would actually be fine for my purpose. I have a whole set of Excel sheets which are suppose to be identical. I am just trying to make sure everyone is running the same "version" and without their own custom changes.
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35013289
Why not version control it?

Sid
0
 
LVL 50

Assisted Solution

by:Dave Brett
Dave Brett earned 450 total points
ID: 35013532
I've done this once before (on values and formulas not scripts) but it is involved as per Sid's comments.

As a starting point, the code made the following checks in descending or derlooking for early exit points for "no match" flags
- compared numbers of sheets
- usedrange size per sheet
- number of formulae per sheet
and only then start compiling strings for each file using arrays

doable yes but extensive coding (will try to find it)

my Mappit! addin produces a summary of sheet usedrange, formulae numbers, hidden cells and also interlinked mappings that can be used to quickly compare two files
http://www.experts-exchange.com/A_2613.html

Alternatively there are existing programs (SpreadSheet Advantage is excellent, Compare.xla is a free addin that also works) that will compare sheet to sheet. But not file by file in a folder as you appear to want

Cheers

Dave

0
 
LVL 81

Expert Comment

by:zorvek (Kevin Jones)
ID: 35013559
sypder,

You are asking to do something that is very difficult and provides little benefit.

Consider all the elements of a workbook that can vary such as formatting, validation rules, column widths, etc.

Use the file save date time. Or add a version number to the document properties.

If you are truly just interested in formulas and VBA code, do a simple comparison of the formulas and VBA code between the two workbooks.

Kevin
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35013686
Further to what I suggested above, I started having more thoughts around it.

Even if you version control it or take the date created or any such parameter there is no guarantee that the file will remain unchanged. The only way I can think of (Please correct me If I am wrong) is to use

"Version Control" PLUS "Protect your formulas and the VB editor"

That ways, the user will not be able to change the formulas nor will they be able to Add/Delete/Modify any code.

Sid
0
 
LVL 50

Assisted Solution

by:Dave Brett
Dave Brett earned 450 total points
ID: 35013742
I can sympathise with the question

I run a business model that takes inputs in templates from 10 businesses that in turn may take inputs from 10 or more individual assets. People DO tinker even when they shouldn't

Locking it down is possinly an option but does signal - maybe correctly - a lack of trust. Possibly, as in some cases some formulae may need end-user modifying to cope with certain circumstances, as long as the modifier implements the change properly and documents it

Hence I do use Mappit! and the other tools to give me comfort on the integrity of the final models.

Cheers

Dave
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35013770
Dave: You are changed your Eeple again. lolzzz... But at least the 'Gender' is correct ;)

With Respect:

>>Locking it down is possinly an option but does signal - maybe correctly - a lack of trust.

Yes that is one way to look at it. However 'protection' can also be looked as an option to prevent deletion of formulas/code by mistake and similar scenarios.

>>in some cases some formulae may need end-user modifying to cope with certain circumstances

That would defeat OP's main question then.

Sid
0
What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 
LVL 81

Expert Comment

by:zorvek (Kevin Jones)
ID: 35013777
>Locking it down is possinly an option but does signal - maybe correctly - a lack of trust.

Who is your user group - grandma?

I lock everything down - but without passwords. Never use passwords. It's a UI attribute.

Kevin
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35013788
Also just to be expand on 'Protection', I didn't mean protect the entire sheet but just the main formula cells while keeping the rest of the cells unlocked so that the users can input their own formulas if they want to.

Sid
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35013790
Whoa! You type very fast Kevin... Your post was not there!!! :)

Sid
0
 
LVL 81

Expert Comment

by:zorvek (Kevin Jones)
ID: 35013794
I'm in Seattle. My bits have about 3,000 fewer miles to travel to San Luis Obispo, CA than from India.
0
 
LVL 50

Expert Comment

by:Dave Brett
ID: 35014617
>That would defeat OP's main question then.

Sure. But I was giving an example from my experience as to why I thought it was a reasonable question

>I lock everything down - but without passwords
Which of course stops inadvertment mistakes, but not intended changes

In this case it's argubale that the sheets should be locked down with passwords to prevent any changes. Which may or may not be possible/optimal depending on the OP situation

until proven otherwise it is a reasonable question :)

Cheers

Dave
0
 
LVL 3

Author Comment

by:sypder
ID: 35014719
It sounds like the concept is doable, but that there is not "quick" script. Thanks for all the thoughts.

I understand all of the comments about version control, but this spreadsheet is dispersed very widely across many different companies, so I cannot expect anyone to follow any one procedure. There are also a few reasons why we cannot password protect the cells. Thanks again.
0
 
LVL 3

Author Comment

by:sypder
ID: 35014738
brettdj, this is very similar to what we have. I would love to just have a spreadsheet that I could use to make sure that everyone has the current formulas, didn't make any changes (unintentional or otherwise), and that there are no numbers within the formula that got tweaked. I will try to code something on my own, just trying to save time if it already existed...
0
 
LVL 50

Accepted Solution

by:
Dave Brett earned 450 total points
ID: 35015872

I found the code I was thinking of that I wrote for a EUSPRIG (Model Audit) Group member. It was a "first" pass, could be similar flag" to show where files may be the same . It could easily be expanded to look at all formulae via a variant array, rather than this first pass test.

Maybe there is scope for me to combine Mappit! http://www.experts-exchange.com/A_2613.html which looks for potential inconsistent formulae inside a file, with a comparsion of formulae between template files. A longer term project that I will consider

My instructions for the user for the code below were:

"This VBA code runs recursively on all .xls* files in, or under C:\test to produce a first pass list of potential duplicates It produces a list of similar files in DupeSummary.CSV

It will automatically skip password protected files

The code compares a concatendated string of

Sheet Count & First Formula in Sheet 1 & Total Formulas in Sheet 1 & First Formula in Last Sheet & Total Formulas in Last Sheet with this line
strUnique = Wb.Sheets.Count & rng1.Cells(1).Formula & rng1.Cells.Count & rng2.Cells(1).Formula & rng2.Cells.Count"

Cheers

Dave
Option Explicit

Public objDic
Public objTF
Public CSV_Written As Boolean

Public Sub Main()
    Dim Wb As Workbook
    Dim objFolder
    Dim objFSO
    Dim strobjFolderPath As String
    Dim strMyDoc As String

    'inital path
    strMyDoc = "C:\test"

    'Setup Application for the user
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
    End With

    Set objDic = CreateObject("scripting.dictionary")
    Set objFSO = CreateObject("scripting.filesystemobject")
    Set objTF = objFSO.createtextfile(strMyDoc & "\DupeSummary.CSV")
    objTF.writeline "Duplicate File" & "," & "Original File"
    Set objFolder = objFSO.getfolder(strMyDoc)

    ShowSubFolders objFolder, True
    ShowSubFolders objFolder, False

    If CSV_Written Then
        objTF.Close
        Set Wb = Workbooks.Open(strMyDoc & "\DupeSummary.CSV")
        With Wb.Sheets(1).Columns("A:C")
            .AutoFit
            .AutoFilter
        End With
    Else
        MsgBox "No Dupes on First Pass", vbInformation
    End If

    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
        .StatusBar = vbNullString
    End With


    CSV_Written = False
    Set objFSO = Nothing
    Set objDic = Nothing

End Sub



Sub ShowSubFolders(ByVal objFolder, bRootFolder As Boolean)
    Dim objShell
    Dim colFolders
    Dim objSubfolder
    Dim Wb
    Dim strUnique As String
    Dim rng1 As Range
    Dim rng2 As Range
    Dim strFname As String


    Set objShell = CreateObject("Shell.Application")
    Set colFolders = objFolder.SubFolders
    Application.StatusBar = "Processing " & objFolder.Path

    If bRootFolder Then
        Set objSubfolder = objFolder
        GoTo OneTimeRoot
    End If

    For Each objSubfolder In colFolders
        'check to see if root directory files are to be processed
OneTimeRoot:
        strFname = Dir(objSubfolder.Path & "\*.xls*")
        Do While Len(strFname) > 0
            strUnique = vbNullString
            On Error Resume Next
            Set Wb = Workbooks.Open(objSubfolder.Path & "\" & strFname, False, , , "dummy")
            Set rng1 = Wb.Sheets(1).Cells.SpecialCells(xlFormulas)
            Set rng2 = Wb.Sheets(Wb.Sheets.Count).Cells.SpecialCells(xlFormulas)
            strUnique = Wb.Sheets.Count & rng1.Cells(1).Formula & rng1.Cells.Count & rng2.Cells(1).Formula & rng2.Cells.Count
            On Error GoTo 0
            If Len(strUnique) > 0 Then
                If Not objDic.exists(strUnique) Then
                    objDic.Add strUnique, objSubfolder.Path & "\" & strFname
                Else
                    objTF.writeline objSubfolder.Path & "\" & strFname & "," & objDic(strUnique)
                    CSV_Written = True
                End If
                Wb.Close False
            Else
                objTF.writeline objSubfolder.Path & "\" & strFname & ",," & "Failed simple formulae or password open test"
            End If
            strFname = Dir
        Loop
        If bRootFolder Then
            bRootFolder = False
            Exit Sub
        End If
        ShowSubFolders objSubfolder, False
    Next
End Sub

Open in new window

0
 
LVL 5

Assisted Solution

by:MedievalWarrior
MedievalWarrior earned 50 total points
ID: 35018362
The following example can be placed into a module (Hashing.bas) if you want to compute hashes. I'll post it for convenience if you come up with a routine that could benefit from using it for comparisions.
// Usage

Debug.Print GetHash("The quick brown fox jumps over the lazy dog.", MD5)
Debug.Print GetHash("The quick brown fox jumps over the lazy dog", SHA1)

Open in new window

'// Hashing.bas

Option Explicit

Private Const PROV_RSA_FULL As Long = 1
Private Const HP_HASHVAL As Long = 2
Private Const CRYPT_VERIFYCONTEXT As Long = &HF0000000
Private Const CRYPT_STRING_HEX As Long = &H4&
Private Const CALG_MD5 As Long = &H8003&       ' 128/8 bits  16 bytes
Private Const CALG_SHA1 As Long = &H8004&       ' 160/8 bits  20 bytes

Public Enum HashAlg
  MD5 = CALG_MD5
  SHA1 = CALG_SHA1
End Enum

Private Declare Function CryptAcquireContextW Lib "Advapi32.dll" (ByRef phProv As Long, ByVal pszContainer As Long, ByVal pszProvider As Long, ByVal dwProvType As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptCreateHash Lib "Advapi32.dll" (ByVal phProv As Long, ByVal Algid As Long, ByVal hKey As Long, ByVal dwFlags As Long, ByRef phHash As Long) As Long
Private Declare Function CryptReleaseContext Lib "Advapi32.dll" (ByVal hProv As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptHashData Lib "Advapi32.dll" (ByVal hHash As Long, ByVal pbData As Long, ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptGetHashParam Lib "Advapi32.dll" (ByVal hHash As Long, ByVal dwParam As Long, ByVal pbData As Long, ByRef pdwDataLen As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptDestroyHash Lib "Advapi32.dll" (ByVal hHash As Long) As Long
Private Declare Function CryptBinaryToStringW Lib "crypt32.dll" (ByVal pbBinary As Long, ByVal cbBinary As Long, ByVal dwFlags As Long, ByVal pszString As Long, ByRef pcchString As Long) As Long

Private hProv As Long
Private hHash As Long

Public Function GetHash(ByVal dataInput As String, ByVal hashAlgType As HashAlg) As String
  
  Dim bufHash() As Byte
  Dim bufDataInput() As Byte
  Dim cbHash As Long
  Dim cbString As Long
  
  GetHash = vbNullString
  
  ' convert input to byte array
  bufDataInput = StrConv(dataInput, vbFromUnicode)
  
  ' Get handle to the crypto provider
  If CryptAcquireContextW(hProv, 0, 0, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT) = 0 Then
    Debug.Print "CryptAcquireContextW failed."; Err.LastDllError
    Exit Function
  End If
  
  ' Create hash type
  If CryptCreateHash(hProv, hashAlgType, 0, 0, hHash) = 0 Then
    Call CleanUp
    Debug.Print "CryptCreateHash failed."; Err.LastDllError
    Exit Function
  End If
  
  ' Hash the input using the hash type
  If CryptHashData(hHash, VarPtr(bufDataInput(0)), UBound(bufDataInput) + 1, 0) = 0 Then
    Call CleanUp
    Debug.Print "CryptHashData failed."; Err.LastDllError
    Exit Function
  End If
  
  ' Check hash method and allocate accordingly.
  Select Case hashAlgType
    Case MD5
      ReDim bufHash(16 - 1) As Byte '// 128 bit
      cbHash = 16
    Case SHA1
      ReDim bufHash(20 - 1) As Byte '// 160 bit
      cbHash = 20
  End Select
  
  ' Obtain the final hash value
  If CryptGetHashParam(hHash, HP_HASHVAL, VarPtr(bufHash(0)), cbHash, 0) Then
    GetHash = ByteToHash(bufHash)
  End If
    
  Call CleanUp

End Function

Private Function ByteToHash(ByRef data() As Byte) As String
    Dim i     As Long
    Dim s1    As String
    Dim s2    As String
    For i = LBound(data) To UBound(data)
        s2 = Hex$(data(i))
        If Len(s2) < 2 Then s2 = "0" & s2
        s1 = s1 & s2
    Next i
    ByteToHash = LCase$(s1)
End Function

Private Function CleanUp()
  
  If (hHash <> 0) Then
    CryptDestroyHash hHash
    hHash = 0
  End If
  
  If (hProv <> 0) Then
    CryptReleaseContext hProv, 0
    hProv = 0
  End If
  
End Function

Open in new window

0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
How to quickly and accurately populate Word documents with Excel data, charts and images (including Automated Bookmark generation) David Miller (dlmille) Synopsis In this article you’ll learn how to use ExcelToWord! to copy data,charts, shapes …
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

707 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now