Solved

Excel VBA Hash of All Formulas and VBA

Posted on 2011-03-01
17
1,033 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
3 Use Cases for Connected Systems

Our Dev teams are like yours. They’re continually cranking out code for new features/bugs fixes, testing, deploying, testing some more, responding to production monitoring events and more. It’s complex. So, we thought you’d like to see what’s working for us.

 
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
 
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

Netscaler Common Configuration How To guides

If you use NetScaler you will want to see these guides. The NetScaler How To Guides show administrators how to get NetScaler up and configured by providing instructions for common scenarios and some not so common ones.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This tutorial explains how to create a series of drop-down lists that are dependent upon prior selections to guide (“force”) the user to make the correct selection and reduce data errors within Microsoft Excel. Excel 2010 was used for this tutorial;…
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

770 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