Iceberg Code

prova tabella

2009-07-22T14:11:00.008+02:00

provo a mettere una tabella per veder se viene bene

campo1	campo2	campo3
32	67	76
17	81	30
67	86	71

Value of Covered Warrant across time

2006-09-17T09:37:00.000+02:00

Some time I trade on stocks and CW.
Usually CW are a robbery especially when they are close to the expiration date, but they are good trading tools because they:
1) let you pay less commissions
2) have an embedded stop loss (if you are not a disciplined trader)
3) reduce trade size
4) leverage the trade to increase the potential return (LOSS) of an investment.

The big problem with CW is that "time goes by" so it is very important to know How long you can hold them and if it is the right time to trade them.

For this reason here you can find the excel
CW_Time_Value.xls
that calculate with Black-Sholes pricing model evolution of price in
different market condition and time horizon.

What did I add to the model that I can't find elsewhere? ... Estimation of Volatility
The original formula need half dozen of variable input to work, but most of them are constants or easy to find, but Volatility is very difficult to get.
For this reason I applied the Bisection method to evaluate Volatility at a given period when both CW price and Underlying Asset Price are known (Open/close price).

The idea behind the Bisection method (In two words) is to compare the output of a formula with the known result of the formula itself when all but one input are known.

In this case we know all the input and the result (open price of the CW) and we want to measure the unknown Volatility.
We know that Volatility should be inside the interval >0% and <1000% so we try the half point:
500%
If the formula output is higher than the open price of the CW we understand that the interval is 0-500%. So we go down to 250%, 125%, 62.5%, 31.25%, 15.625%, 7,8125%
and the volatility should be higher than 7,8125% so now we go up: 11.71875%, 13.671875%, ...
the volatility interval should be 13.671875% - 15.625%

As you see we decrease very fast the order of magnitude of the interval (even if we start from a creasy value like 100,000%).
We must stop this recursive testing when the difference of the calculated output and the know result of the formula is less than the significant decimal (0.0001)

Here the formula to evaluate the embedded Volatility

Function CwStimaVolatilitaData(ByVal ValoreCW As Single, ByVal ValoreSottostante As Single, ByVal StrikePrice As Single, ByVal Scadenza As Date, ByVal TassoBCE As Single, Optional ByVal Moltiplicatore As Single = 1, Optional ByVal CwCall As Boolean = True) As Single
     Application.Volatile
     Dim AnniResidui As Single, Volatilita As Single, DeltaVolatilita As Single, Distanza As Single, a As Single, b As Single, c As Single, d1 As Single, d2 As Single
     AnniResidui = (Scadenza - Date) / 365
     Volatilita = 1000
     DeltaVolatilita = Volatilita / 2
     Distanza = 1000
     Do Until Abs(Distanza) < 0.0001
     Distanza = CwStimaValore(ValoreSottostante, StrikePrice, AnniResidui, TassoBCE, Volatilita, Moltiplicatore, CwCall) - ValoreCW
         If Distanza > 0 Then
             Volatilita = Volatilita - DeltaVolatilita
         Else
             Volatilita = Volatilita + DeltaVolatilita
         End If
     DeltaVolatilita = DeltaVolatilita / 2
     i = i + 1
     Loop
     CwStimaVolatilitaData = Volatilita
End Function

Download it Now!

Enjoy it!

Split & Merge

2006-06-27T00:46:00.000+02:00

This is part one of two post.
When you work on your own, you don't care to divide you big workbook in a multitude
of smallest files to deploy to tens of users that must see only they own piece.
... and Excel become a nightmare.
How do you split a 10 thousands row worksheet into 200 X 50 workbook?
Or how do you split a workbook with 5 different sheets?
I worked out this solution:
SplitExcelFile.xls

You just need to set:
1) Which worksheet split, and the name of the field that must be split
2) the list of value to split and
3) the parametric name of all the output workbook.

Enjoy it!

TOC & JS

2006-06-19T23:55:00.000+02:00

I have posted few things and now it's time to add a TOC (Table of Content) to search faster all the contents.
So I added some JavaScript to enjoy sorting. To get the code you can just "view Source"...

Click to view TOC

If You like mp3 you gonna love this excel

2006-06-15T09:06:00.000+02:00

After updating my previous Excel List File, I'm trying to specialized it.
So lets try this useful MP3_Info.xls excel that just find any mp3 on your PC and ...

... get all TAGs info about any single file: Amazing!

Enjoy it!

Most Useful Access Code

2006-06-06T14:21:00.000+02:00

Maybe I'm a little bit too enthusiastic about this module but I use it so often that I consider it the most useful ...

The main idea is to store all the queries action in a table and run them from it.
With a table that contain all kind of queries, you just need to sort and flag them as runable.

Here the TR (track record) of the "SQL_List" table:
SQL_ID (counter)
SP_NAME (the name of the Stored Procedure)
Run_it (a flag to run or not them)
OrderSQL (the order sorting)
What_is_doing (description for portability)
SQL (The SQL of the action query)

What is an Action Query?
The one that does not just show records and does something like update, delete, append, create, ...

What is a SP (Stored Procedure)?
When you start using SQL-server you can really understand it. In short is a list of action, a program to get the result you want

Back to the SQL_List, here an example of how to query it:
SELECT SQL FROM SQL_List WHERE SP_NAME="Test" AND Run_it=1 ORDER BY OrderSQL;

To better use it you should use a Macro, that contain just one Action:
RunCode [ExecListOfQueries ( "SELECT SQL FROM SQL_List WHERE SP_NAME='Test' AND Run_it=1 ORDER BY OrderSQL")]

And here the core of the entire trick you need a module with the code:
ModuleName: UsefullAccessCode
The code is very simple:

Function ExecListOfQueries(MySQLList)
' stop warning
DoCmd.SetWarnings False
Dim dbs As DAO.Database, rst As DAO.Recordset, TempSQL
Set dbs = CurrentDb

' The list of queries
Set rst = dbs.OpenRecordset(MySQLList)
' if there are some records loop the result
If rst.EOF = False And rst.BOF = False Then
     rst.MoveFirst
     Do While rst.EOF = False
         ' loop to Execute all the queries
         ' replace double quote with single one to avoid error
         TempSQL = Replace(Replace(rst.Fields(0).Value, """", "'"), vbCrLf, " ")
         'Debug.Print TempSQL
         DoCmd.RunSQL TempSQL
     rst.MoveNext
     Loop
End If
rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing
End Function

In this example Run_SQL_List.mdb you get all you need to test the code

The thing I most appreciate in this trick is the portability and flexibility.
... You can store all the queries in a single DB and use linked table to the "SQL_List" table, so it's easier to reuse queries from a project to another
... Or in ASP project you can change queries without changing the code.
... Most of all, the queries stay in a single place!

Download it Now!

Enjoy it!

Most used balls in Milan

2006-05-07T09:12:00.000+02:00

Click to Download a bigger Image

Put your heel in the bull's balls and make a full turn on your heel.
This will bring you good luck!
- Mosaics on the ground in the center of Galleria Vittorio Emanuele II (near Duomo)
Remarks: paper airplane flies to North close to Google's balls

45°27'56.18"N
9°11'19.82"E

For more info:
Search Google EN
Search Google IT
Original Google Earth Post

Self Query Excel

2006-04-27T00:02:00.000+02:00

This is just a simple but useful function to self query Excel.
This mean that once you insert a named range you can query it,
with this Array Function:

Function SQL2Range(MySQL As String)
'Example: =SQL2Range("SELECT * FROM MyRange")
'On Error Resume Next ' Enable error-handling routine.
     Dim objRsExcel As Object, sConn As String, strExcelPath As String, strExcelFileName As String, output
     Set objRsExcel = CreateObject("ADODB.Recordset")

     strExcelPath = ThisWorkbook.Path & "\"
     strExcelFileName = ThisWorkbook.Name

     objRsExcel.CursorLocation = 3

' objRsExcel.CursorType = 0 'adOpenForwardOnly
     objRsExcel.CursorType = 0 'adOpenStatic
' objRsExcel.CursorType = 0 'adOpenForwardOnly
' objRsExcel.CursorType = 0 'adOpenForwardOnly
' objRsExcel.LockType = 1

     sConn = "DRIVER=Microsoft Excel Driver (*.xls);" & "DBQ=" & strExcelPath & strExcelFileName
     objRsExcel.Open MySQL, sConn

     output = objRsExcel.GetRows()

     objRsExcel.Close
     Set objRsExcel = Nothing

SQL2Range = Application.WorksheetFunction.Transpose(output)
End Function

Array Function are the one inserted in a range with Shift+Control+Enter

Add a Menu to a Excel Menu Bar

2006-04-11T08:25:00.000+02:00

In the AddMenu.xls file you find a usefull worksheet
where you can set a personalised drop down Menu with all the commands to control your application.

This tool is full of tips and tricks in order to be as flexible as possible,
you don't need to modify the core of the code to change the menu
All the interface and control stay in the "MenuSheet" worksheet.

Let me explain my VBA way of Coding.
1) Let Excel do 99% of the work, so with little code you get great Result
2) Save all the variable in the worksheet, avoid constants and var inside the code
3) Let Spreadsheet and VBA communicate with Named Range
4) Use dynamic range to let expand the universe
5) Give the end user a lot of drop down menu in cells to avoid error
6) Copy and Paste ... Someone already did it
7) Divide and conquer ... small piece of code are smarter

That's said let see how to implement it in the real world
When you open AddMenu.xls workbook you are faced with a setting worksheet
where you can set everything to build your own Menu.

The table on the left contains all the info to give name and action to any button
The table can contain as many rows as you like (use dynamic range)

Then you have 3 variable on the top centre
the first 2 are to set the name and the position of the new Menu
The last one is a service variable that set the visibility
of the worksheet itself. When do you use this var? When you are done with all the
settings and you don't need anymore to show the setting worksheet, you can hide it
and give all to the final user.

The BarName Var can be chosen in a drop down menu, so you need a list of items.
The list is dynamic and refers to a named range.

So on the Excel side we are almost ready,
now lets give a name to all the ranges (I dont' have fantasy):

CaptionAction (table with list of all buttons - Dynamic)
BarName (where to put the new Menu)
MenuName (new Menu' name)
SheetVisible (to set the sheet visible)
ListCommandBars (all the CommandBar Name - Dynamic)

Why do I use named range? Why don't use absolute address?
Because VBA does not update if you change the position of a $A$1
style range. That's happen if you add/remove row/column
or you just move the cell with the data.
But if you give name to a range now, it's Excel that link the name
to the absolute position and when VBA recall it's an excel task to do
things right.
How to name range? there are 2 way the fast one and the slow one
Fast one is select a 2 column row range and follow the menus
[Insert][Name][Create]...
The slowest is [Insert][Name][Define].
Use the first when you have a list of Var (named on the left)
Use the second when you have a table to be named or
you want to build a Dynamic Named Range.

Setting a Dynamic Named Range is just a matter of Offset:

=MenuSheet!$A$2:OFFSET(MenuSheet!$A$2;COUNTA(MenuSheet!$A$2:$A$65536)-1;2)

It means that the table start at cell A2 and finish 3 column on the right (;2)
and down how many rows are not empty on the first column.
Once understand the logic, you can adapt to any direction (not just down)

To set the BarName Var you need to Populate the list of all CommandBars Names, there is a little sub:

Sub SetListCommandBars()
' This sub need to refer to the ListCommandBars named range
' work faster
Application.ScreenUpdating = False
' get the first cell of the "ListCommandBars" range
Set MyRange = Range("ListCommandBars").Cells(1)
' empty the range
Range("ListCommandBars").Clear
' populate the range with all CommandBars Name
For i = 1 To CommandBars.Count
MyRange.Offset(i - 1) = CommandBars(i).Name
Next i
Application.ScreenUpdating = True
End Sub

The sub to work needs the "ListCommandBars" named range in the worksheet:

=MenuSheet!$M$2:OFFSET(MenuSheet!$M$2;COUNTA(MenuSheet!$M$2:$M$65536)-1;0)

Now lets Code!
In the VBA Module there are a lot of small functions and sub to get ready to go
and to check some error, but the core is the one that's add the new menu and all
the buttons in it:

Sub AddMenu() 'create a new menu item with all the subMenu
SetVar 'Take all the Var from the worksheet and makes avaibale in VBA
Dim i As Integer
' If the menu already exists just exit
     If MenuExists(BarName, MenuName) Then Exit Sub
' The menu does not exists so add it ...
     Set mypopup = CommandBars(BarName).Controls.Add(Type:=msoControlPopup)
     mypopup.Caption = MenuName

' Add the SubMenu
     For Each Cell In CaptionActionFirstCol
     ' if you preffer, you can avoid double names!
     If Len(Cell.Value) > 0 And Not SubMenuExists(BarName, MenuName, Cell.Value) Then
     'If Len(Cell.Value) > 0 Then 'simplest one
     Set myitem = mypopup.Controls.Add(Type:=msoControlButton)
         With myitem
             .Caption = Cell.Value
             If Len(Cell.Offset(0, 1).Value) > 0 Then .OnAction = Cell.Offset(0, 1).Value
             If Cell.Offset(0, 2).Value > 0 Then .FaceId = Cell.Offset(0, 2).Value
         End With
     End If
     Next Cell
End Sub

It looks very simple and it is, but remember that 99% of the work
has been done by Excel!

Download it Now!

Barcode within Excel

2006-03-31T23:45:00.000+02:00

It could happen one day that you need to print a Barcode.
Well in the Barcode.xls files you can get all you need to do it within Excel.

First you need to install the Barcode Fonts (in the file you find them - "Free 3 of 9" & "Free 3 of 9 Extended" The origin of the fonts could be lost)

How To add a new font to your computer?

1. Click Start, point to Settings, click Control Panel, and then double-click Fonts.
2. On the File menu, click Install New Font.
3. Click the drive, and then click the folder that contains the fonts you want to add.
4. Click the font you want to add.

Notes
* To select more than one font to add, hold down the CTRL key, and then click each of the fonts you want.

* For TrueType, Raster, or Adobe Type 1 fonts, you can also add the font by dragging the appropriate files to the Fonts folder. If you want to see the file extensions in Windows Explorer, click View, click Options, and then click the View tab. Click to clear the Hide file extensions for known file types check box. This works only for fonts that are not in the Fonts folder.

Now you are ready to translate all your code in a Barcode, but before you have to add a checksum to your original code. To do this you'll find 3 function that calculate the correct code: Append_EAN_Checksum, Format_Code128 and Format_UPC_String

Download it now
As usual if you prefer to read the code you can do it below:

'EAN -13
'EAN-13 is used world-wide for marking retail goods.
'The symbol encodes 13 characters: the first two or three are a country code which
'identify the country in which the manufacturer is registered (not necessarily where
'the product is actually made). The country code is followed by 9 or 10 data digits
'(depending on the length of the country code) and a single digit checksum. 2-digit
'and 5-digit supplemental barcodes may be added for a total of 14 or 17 data digits.
'
'The Uniform Code Council (the organization which issues retail codes in the USA)
'has announced that January 1, 2005 will be the date by which all retail scanning
'systems in the USA must be able to accept the EAN-13 symbol as well as the standard
'UPC-A. This change will eliminate the need for manufacturers who export goods to
'the US and Canada to double-label their products.
'
'The checksum is a Modulo 10 calculation:
'
Add the values of the digits in the even-numbered positions: 2, 4, 6, etc.
Multiply this result by 3.
Add the values of the digits in the odd-numbered positions: 1, 3, 5, etc.
Sum the results of steps 2 and 3.
The check character is the smallest number which, when added to the result in step4, produces a multiple of 10.
Example: Assume the barcode data = 001234567890

0 + 2 + 4 + 6 + 8 + 0 = 20
20 * 3 = 60
0 + 1 + 3 + 5 + 7 + 9 = 25
60 + 25 = 85
85 + X = 90 (nearest equal or higher multiple of 10), therefore X = 5 (checksum)
Here is a sample Visual Basic function to calculate the checksum:

Function Append_EAN_Checksum(RawString As String)
     Dim Position As Integer
     Dim Checksum As Integer

     Checksum = 0
     For Position = 2 To 12 Step 2
           Checksum = Checksum + Val(Mid$(RawString, Position, 1))
     Next Position
     Checksum = Checksum * 3
     For Position = 1 To 11 Step 2
           Checksum = Checksum + Val(Mid$(RawString, Position, 1))
     Next Position
     Checksum = Checksum Mod 10
     Checksum = 10 - Checksum
     If Checksum = 10 Then
           Checksum = 0
     End If
     Append_EAN_Checksum = RawString & Format$(Checksum, "0")
End Function

'Calculating a Code 128 Barcode Checksum in Access Basic
'This bit of Access Basic (same as Visual Basic) will calculate a Code 128 Modulo 103 checksum.
'Barcode fonts from different publishers may map the some characters to
'different locations, so be sure to check.

Function Format_Code128(InString As String) As String
     Dim Sum As Integer, i As Integer
     Dim Checksum As Integer, Checkchar As Integer
     Dim MyString As String, CVal As Integer

     '
     ' Initialize running total with value of
     ' Subset B start character
     '
     Sum = 104
     '
     ' Scan the string and add character value times position
     '
     For i = 1 To Len(InString)
         '
         ' Copy one character from InString position i to MyString
         '
         MyString = Mid$(InString, i, 1)
         '
         ' Get the numeric value of the character and subtract
         ' 32 to shift (the space character, ASCII value 32, has
         ' a numeric value of 0 as far as Code 128 is concerned)
         '
         CVal = Asc(MyString) - 32
         '
         ' Add the weighted value into the running sum
         '
         Sum = Sum + (CVal * i)
     Next i
     '
     ' Calculate the Modulo 103 checksum
     '
     Checksum = Sum Mod 103
     '
     ' Now convert this number to a character. This conversion
     ' takes into account the particular mapping of the font
     ' being used (this example is for the font published by
     ' Azalea Software.
     '
     If CheckDigit = 0 Then
         Checkchar = 174
     ElseIf CheckDigit < 94 Then
         Checkchar = CheckDigit + 32
     Else
         Checkchar = CheckDigit + 71
     End If
     '
     ' Now format the final output string: start character,
     ' data, check character, and stop character
     '
     MyString = Chr(162) + InString + Chr(Checkchar) + Chr(164)
     Format_Code128 = MyString
End Function

'UPC retail codes require a Modulo 10 check digit.
'This sample code accepts the UPC number, calculates the check digit,
'and returns the finished string.
'
'The general method involves adding up the digits in the odd-numbered
'positions and multiplying that sum by 3; then adding to that result
'the values of the digits in the even-numbered positions.
'Divide this result by 10 and subtract the remainder from 10.
'If the result is equal to 10, set it to zero; otherwise this is the check digit.

Function Format_UPC_String(InString As String) As String
     Dim OutString As String
     Dim Multiplier As Integer, Sum As Integer, i As Integer
     Dim CheckDigit As Integer
     '
     ' Initialize the sum to zero
     '
     Sum = 0
     '
     ' Add up the values of digits in the odd-numbered positions
     '
     For i = 1 To Len(InString) Step 2
         Sum = Sum + Val(Mid$(InString, i, 1))
     Next i
     '
     ' Multiply this result by 3, then add in the values of
     ' the digits in the even-numbered positions
     '
     Sum = Sum * 3
     For i = 2 To Len(InString) Step 2
         Sum = Sum + Val(Mid$(InString, i, 1))
     Next i
     '
     ' Now calculate the Modulo 10 check digit
     '
     CheckDigit = Sum Mod 10
     CheckDigit = 10 - CheckDigit
     If CheckDigit = 10 Then
         CheckDigit = 0
     End If
     OutString = InString + Format$(CheckDigit)
     Format_UPC_String = OutString
End Function

String 2 Morse

2006-03-31T22:49:00.000+02:00

This is a function to translate any String in Morse Code,
I don't know if it is a useful function, but if you are
starting to study VBA, it's a nice code to read

Function txt2morse(ByVal text As String) As String
Dim Letters As String, Morse As String, arrMorse() As String, i As Long
    Letters = " ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789.,?/:"
    Morse = " ,.-,-...,-.-.,-..,.,..-.,--.,....,..,.---,-.-,.-..,--,-.,---,.--.,--.-,.-.,...,-,..-,...-,.--,-..-,-.--,--..,-----,.----,..---,...--,....-,.....,-....,--...,---..,----.,.-.-.-,--..--,..--..,-..-. ,-...-"
    arrMorse = Split(Morse, ",")
    text = UCase(text)
    For i = 1 To Len(text)
        txt2morse = txt2morse & " " & arrMorse(InStr(1, Letters, Mid(text, i, 1)) - 1)
    Next
    txt2morse = Trim(txt2morse)
End Function

Why do I program?

2006-03-29T01:54:00.000+02:00

I started programming at school for an exam, and I thought all I need was to pass it. That's was right, but when I started working I couldn't get enough to be just a small end-user who have to thanks any junior or (pseudo)senior programmer telling me that all can be done, but ... they never did.

One day my father teach me that:
"If a stupid more stupid than you did it, why can't you get it?"

This was for my driving licence, but till now it worked out for almost anything.
Maybe I could write the first "one row" self help book with this phrase. I'll think about it!

... so I started use Excel and all its functions, but it wasn't enough, I wanted more, so I re-started learning programming.

How to learn?
Well I did some macro recording, but the code was not flexible enough so I pick a book with some VBA Examples (Laboratorio di VBA)
It was not enough ...
So I got the Walkenbach bible (in French) Excel 2000 - programmer avec VBA

It was enough! from now on, to get more I had to browse the web and to do my own.
It's always a matter of equilibrium:
What you should let excel do and when let VBA start play.
How to organise your data and your spreadsheet.
This is just a matter of experience (stratified error)

Just to better illustrate my point of view I've been a little far from VBA to VB with Balena (Programming Microsoft Visual Basic 6.0)
But after a little bit of hesitation I come back to Excel and VBA because I usually be the end-user of my creation so I need just a flexible tool fast, quick and ... clean.

If you start build your own forms with VB you get creasy counting pixels to arrange all the objects you put on it, and after all I don't want to rebuild Excel to manipulate the output/input.

Know I feel comfortable with VBA, SQL, Javascript, HTML and of course Excel,
and I have to thank all the author of books and web site,
with a special thank to Joel Spolsky
... but maybe, most of all I should thank all the people who ask and answer groups!

Thank you

When you forgot Password ... you need to break them!

2006-03-29T00:46:00.000+02:00

It's easy because the Excel worksheet protection is not very strong.

For some people this a bug, for me it is ok, because I use protection
just to prevent end-user destruction! ... If You know what I mean.

So you can put any kind of password and forget it, because with
the code I post now you are no more in trouble.

personally I like this pwd "sdsadsadsdssdadadasdsadsadasdasdas"
(you can break with "AAAAAABBBBAe")

This code is not mine it comes from Aaron T. Blood web page
www.xl-logic.com/pages/vba.html
here the file (the original one):
password_hack.xls
After reading the code don't tell me that programming is not a kind of magic!

This is my first occasion to thank all the smart guy out there that likes to share
their knowledge!
Here's the code (I don't understand ... but I adapt myself):

Sub breakit()
Dim i As Integer, j As Integer, k As Integer,
Dim l As Integer, m As Integer, n As Integer
On Error Resume Next
For i = 65 To 66
For j = 65 To 66
For k = 65 To 66
For l = 65 To 66
For m = 65 To 66
For i1 = 65 To 66
For i2 = 65 To 66
For i3 = 65 To 66
For i4 = 65 To 66
For i5 = 65 To 66
For i6 = 65 To 66
For n = 32 To 126
ActiveSheet.Unprotect Chr(i) & Chr(j) & Chr(k) & Chr(l) & Chr(m) & Chr(i1) & _
Chr(i2) & Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
Application.StatusBar = Chr(i) & Chr(j) & Chr(k) & Chr(l) & Chr(m) & Chr(i1) & _
Chr(i2) & Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
If ActiveSheet.ProtectContents = False Then
MsgBox "One useble password is " & Chr(i) & Chr(j) & Chr(k) & Chr(l) & Chr(m) & _
Chr(i1) & Chr(i2) & Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
Exit Sub
End If
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
End Sub

VBA Code Extractor

2006-03-29T00:02:00.000+02:00

In previous post you selected unique files (ANY) and now you'd like
to search inside all the beautiful VBA code you written or you got there
or elsewhere.

For this reason I found a elegant solution on the web and
I improved a little (I just put an interface to it)

ExportCode.xls

Note: to use this particular macro you have to change
an Excel setting (if you don't you'll get nothing):

So just follow the Excels Menus
[Tools][Macro][Security...] to [Trusted Sources]
and activate "Trust access to Visual Basic Project"

After you run it you get a lot of *.cod files and maybe
you'd like to merge all them to better search inside with
a text editor (I use ultraedit).

To do this you just need a simple batch file:
copy and paste this one-row code in a file you call "Merge.bat"

copy *.cod Merged.txt

... and run it, now you have a big file with all your VBA code to search inside!

Comparing files ... when you have too many files

2006-03-28T22:44:00.001+02:00

In the last post I uploaded a spreadsheet to search all files in your PC
but now you got too many files, and if you are like me (I never throw away a
file and I do some kind of confusing versioning) you can get lost quick to find
latest version.

I've been looking around, but I didn't find anything that fit my needs, so
as usual I did my own.

Compare two files and decide if they are identical it's a kind of art
(without open them). I remarked that 2 identical files can be different
in byte comparing just because one has been closed with cell A1 selected
and another with cell B2 ...

So comparing them just byte by byte it's not enough.
For this reason I personally consider identical files with same lenght
and 98% or more bytes identical ...

I did 2 functions, the first to know if 2 file are 100% identical
and the second to know how much they are similar

If you don't like to read code, but you need just a solution
please download it know: File_Move_Rename.xls

Remarks that in the spreadsheet there are other functions:
FileMoveFile, FileDeleteFile, FolderCreate, FolderExists, ...

So first you need a simple code to compare files
Here's the code (ops ... comments are in Italian):

Sub testFileBynaryCompare()
Dim BinaryFile1, BinaryFile2, MyStart, MyResult
     BinaryFile1 = "c:\P4.html"
     BinaryFile2 = "c:\p3.html"
     MyStart = Now
     MyResult = FileBynaryCompare(BinaryFile1, BinaryFile2)
     MsgBox (Now - MyStart) * 86400 * 1000000000 / FileLen(BinaryFile1) & " sec / giga"
     MsgBox MyResult
End Sub

Function FileBynaryCompare(ByVal BinaryFile1 As String, ByVal BinaryFile2 As String) As Boolean
' funzione che verifica se 2 file sono uguali per ogni singolo byte
' verifico che i file esistono
     If (Len(Dir(BinaryFile1)) = 0) Then GoTo ExitFunction
     If (Len(Dir(BinaryFile2)) = 0) Then GoTo ExitFunction
'verifico che abbiano dimensioni uguali
     If FileLen(BinaryFile1) <> FileLen(BinaryFile2) Then GoTo ExitFunction

' dimensione della stringa estratta
Dim BYTE_SIZE
BYTE_SIZE = 5000
Dim StrVar1 As String * 5000
Dim StrVar2 As String * 5000
Dim FileNum1, FileNum2, i
' Apro il primo file
FileNum1 = FreeFile
Open BinaryFile1 For Binary Access Read As #FileNum1
' Apro il secondo file
FileNum2 = FreeFile
Open BinaryFile2 For Binary Access Read As #FileNum2
'confronto 5000 byte alla volta
i = 1
Do Until EOF(FileNum1)
     Get #FileNum1, i, StrVar1
     Get #FileNum2, i, StrVar2
         If StrVar1 <> StrVar2 Then GoTo ExitFunction
     i = i + BYTE_SIZE
Loop
' se sono arrivato qui vuol dire che sono uguali
FileBynaryCompare = True

ExitFunction:
Close #FileNum1
Close #FileNum2

End Function

But, if the too files are similar for 99% you don't
get the result you expect so with a little modification
you can get a better result

Sub testFileSimilitude()
Dim BinaryFile1, BinaryFile2, MyStart, MyResult
     BinaryFile1 = "c:\P4.html"
     BinaryFile2 = "c:\p3.html"
     MyStart = Now
     MyResult = FileSimilitude(BinaryFile1, BinaryFile2)
     MsgBox (Now - MyStart) * 86400 * 1000000000 / FileLen(BinaryFile1) & " sec / giga"
     MsgBox MyResult
End Sub

Function FileSimilitude(ByVal BinaryFile1 As String, ByVal BinaryFile2 As String) As Single
' funzione che verifica se 2 file sono uguali per ogni singolo byte
' verifico che i file esistono
     If (Len(Dir(BinaryFile1)) = 0) Then GoTo ExitFunction
     If (Len(Dir(BinaryFile2)) = 0) Then GoTo ExitFunction
'verifico che abbiano dimensioni uguali
Dim FileLen1
     FileLen1 = FileLen(BinaryFile1)
     If FileLen1 <> FileLen(BinaryFile2) Then GoTo ExitFunction

If FileBynaryCompare(BinaryFile1, BinaryFile2) = True Then
FileSimilitude = 1
GoTo ExitFunction

End If
' dimensione della stringa estratta
Dim BYTE_SIZE
BYTE_SIZE = 5000
Dim StrVar1 As String * 5000
Dim StrVar2 As String * 5000
Dim FileNum1, FileNum2, i, k, j As Single
' Apro il primo file
FileNum1 = FreeFile
Open BinaryFile1 For Binary Access Read As #FileNum1
' Apro il secondo file
FileNum2 = FreeFile
Open BinaryFile2 For Binary Access Read As #FileNum2
'confronto 5000 byte alla volta
i = 1
j = 0
Do Until EOF(FileNum1)
Get #FileNum1, i, StrVar1
Get #FileNum2, i, StrVar2
If StrVar1 <> StrVar2 Then
For k = 1 To Len(StrVar1)
If Mid(StrVar1, k, 1) <> Mid(StrVar2, k, 1) Then j = j + 1
If j > FileLen1 / 20 Then GoTo ExitFunction
Next
End If
i = i + BYTE_SIZE
Loop
' se sono arrivato qui vuol dire che sono uguali
If FileLen1 = 0 Then
FileSimilitude = 1
Else
FileSimilitude = (FileLen(BinaryFile1) - j) / FileLen(BinaryFile1)
End If
ExitFunction:
Close #FileNum1
Close #FileNum2

End Function

Remark that Function FileSimilitude is a lot slower than FileBynaryCompare

Excel List File

2006-02-28T12:12:00.000+01:00

I have so many file and it's so hard to find them...
I'd like to search and sort them within Excel. I think it's easier because Excel manage big list.

For this reason I did a Excel file. List_File.xls to search, sort any file. It is very easy and fast to use!

Here's the code:

'32-bit API declarations
Public IndirizzoDirectory As String
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
   Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

Declare Function SHBrowseForFolder Lib "shell32.dll" _
   Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Public Type BROWSEINFO
   hOwner As Long
   pidlRoot As Long
   pszDisplayName As String
   lpszTitle As String
   ulFlags As Long
   lpfn As Long
   lParam As Long
   iImage As Long
End Type

Sub Sub_GetDirectory()
     ' Just to set some VAR and cal the GetDirectory Function
     Dim Msg_Directory As String
     Msg_Directory = Range("Msg_Directory")
     Range("Directory") = GetDirectory(Msg_Directory)
End Sub

Function GetDirectory(Optional Msg) As String
     ' open the browser to select a Directory into the PC
     Dim bInfo As BROWSEINFO
     Dim path As String
     Dim r As Long, x As Long, pos As Integer

' Root folder = Desktop
     bInfo.pidlRoot = 0&

' Title in the dialog
     If IsMissing(Msg) Then
         bInfo.lpszTitle = "Select a folder."
Else
bInfo.lpszTitle = Msg
End If

' Type of directory to return
bInfo.ulFlags = &H1

' Display the dialog
x = SHBrowseForFolder(bInfo)

' Parse the result
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Else
GetDirectory = ""
End If
End Function

Sub GetListFile()
' Just to set some VAR and call the ListFiles Sub
Dim SubFolder As Boolean, _
Directory As String, _
FileType As String

Directory = Range("Directory")
FileType = Range("FileType")
SubFolder = Range("SubFolder")

ListFiles Directory, FileType, SubFolder

End Sub

Sub ListFiles(Optional ByVal IndirizzoDirectory As String = "C:\", Optional ByVal NomeFile As String = "*.*", Optional ByVal CercaSottoCartelle As Boolean = False)
' if the directory is not ending with "\" it add it
If Right(IndirizzoDirectory, 1) <> "\" Then IndirizzoDirectory = IndirizzoDirectory & "\"

Range("OutPut").ClearContents

' Insert headers
r = 1

Cells(r, 1) = "Name"
Cells(r, 2) = "Size"
Cells(r, 3) = "Date/Time"
Range("A1:C1").Font.Bold = True
r = r + 1

On Error Resume Next
With Application.FileSearch
.NewSearch
.LookIn = IndirizzoDirectory
.Filename = NomeFile
.SearchSubFolders = CercaSottoCartelle
.Execute
For i = 1 To .FoundFiles.Count
Cells(r, 1) = .FoundFiles(i)
Cells(r, 2) = FileLen(.FoundFiles(i))
Cells(r, 3) = FileDateTime(.FoundFiles(i))
r = r + 1
Next i
End With
End Sub

Download it now

Excel Sudoku Solver

2005-12-16T03:02:00.000+01:00

If you like Sudoku and you can't wait to verify your solution you can use this
Excel Sudoku Solver.
It is password protected, but the code inside is very simple, because all the job is done by Excel itself The code just add some "copy and paste".

The Interesting aspect of this workbook is the warning that force (ehm ... suggest) the end user to activate macros.

In next future I will post How to add this warning!

Download it now

Bird pit Stop

2005-12-16T02:14:00.000+01:00

First snow in Milan

2005-12-16T02:11:00.000+01:00

Where's my Pants???

2005-12-16T01:52:00.000+01:00

Welcome!

2005-11-08T06:22:00.000+01:00

Thank you visiting ICB - Iceberg Code Blog

Why a Bloog? because it is quick and ... clean :-)
This is the place, where I'd like to share my ideas and some useful code (VB, Excel, T-SQL, JavaScript, ...)

Some code I'd like to share have been found on the web (I don't remember where) or I have created by myself, so it can be your code or mine, it doesn't matter to me.

The only thing matter is that the code works!

Why Iceberg?
Because They are made of water, they look pure and they are beautiful.
They born and then "lives" till they slowly fuse and die. They can be dangerous.
This is a good metaphor to coding and technologies in general.
You need to know just 10% of them to understand their size and importance,
the rest are details, and understand all of them takes more time than they are gone.
And after all Nothing is wasted Only reproduced.

By the way, I'm always looking for the perfect code that does not exist,
but the optimized one can exist, so please leave a comment to improve it!