Comparing Two List

Hey Guys,

having problems in ffinding duplicates between two numerical list?
Here the solution:

Download the two lists comparing spreadsheet

The spreadsheet can be used for text lists as well but it might be possible you need to reformat the texts before comparing them.

Enjoy

2D & 3D Animation With Excel

Hi Guys,

please find enclosed an Excel File showing 2D and 3D animations with Excel.

Download the animation:
2D & 3D Animation with Excel

Enjoy

List Files In A Specif Folder

Hi Guys,

Today I will show you how to select a folder from your computer and list all the files in it.

The Macro will also give you information about the files like:

1 - Name
2 - Size
3 - Date and Time


Sub ListFilesInAFolder()

'######################################################################

'Author Paolo Succo
'Date 12 December 2011

'Macro to list files in a folder

'######################################################################

Dim directory As String
Dim r As Long
Dim f As String
Dim path As String


'Select folder
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select a location for the file list"
.Show

Range("A:C").Select
Selection.Delete
ActiveSheet.Shapes.Range(Array("Bevel 1")).Select
Selection.ShapeRange.IncrementLeft 150#
Selection.ShapeRange.IncrementTop -0.75

If .SelectedItems.Count = 0 Then
MsgBox "Canceled"
Else
path = .SelectedItems(1)
path = directory


r = 1

'Headers
Cells(r, 1) = "Filename"
Cells(r, 2) = "Size"
Cells(r, 3) = "Date/Time"
Range("a1:c1").Font.Bold = True

'Get file
f = Dir(directory, vbReadOnly + vbHidden + vbSystem)
Do While f <> ""
r = r + 1
Cells(r, 1) = f
Cells(r, 2) = FileLen(directory & f)
Cells(r, 3) = FileDateTime(directory & f)

'get next file
f = Dir()

Loop

End If
End With

Cells.EntireColumn.AutoFit

End Sub

Download an example:

Files_List.xlsm

Can Excel Speak? Yes It Can!!!

Hi Guys,

Today I will show you how to create a function to make your Excel read texts.

The function is the following:

'######################################################################

'Author Paolo Succo
'Date 12 December 2011

'Function to make your spreadsheet red texts

'######################################################################

Function Talk(txt)

Application.Speech.Speak (txt)
Talk = txt

End Function

After creating a VBA module with this VBA code, you will beallow to use a new Excel formula called "Talk".
Write your text in any cell in your spreadsheet and make the formula read the text.

E.g.

Write the text in A1 and enter in B1 the formula =Talk(A1)

I hope you enjoy!

Proper Function VBA

Today I am going to present a simple macro to simulate the Excel proper function.
Please note that every formula in the spreadsheet will be converted to value.

Sub Capitalization()

'######################################################################

'Author Paolo Succo
'Date 09 December 2011

'Proper Function VBA
'Please note that all formulas will be converted as values

'######################################################################

Dim LastColumn As Integer
Dim LastRow As String
Dim ColumnLetter As String
Dim ColumnRange As String
Dim Target As Range

Dim ClickOption As String
Dim WarningMsg As String

WarningMsg = "Please be aware that all data will be converted as values and texts will be formatted as requested." & vbNewLine & "Would you like to proceed anyway?"

ClickOption = MsgBox(WarningMsg, vbQuestion + vbYesNo, "Warning!!!")
If Answer = vbYes Then

'Find Column Number
If WorksheetFunction.CountA(Cells) > 0 Then
LastColumn = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
End If

'Find Column Letter
If LastColumn > 26 Then
ColumnLetter = Chr(Int((LastColumn - 1) / 26) + 64) & Chr(((LastColumn - 1) Mod 26) + 65)
Else
ColumnLetter = Chr(LastColumn + 64)
End If

'Find Last Row
If WorksheetFunction.CountA(Cells) > 0 Then
LastRow = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
End If

ColumnRange = ColumnLetter + LastRow
Range("A1:" & ColumnRange).Select

For Each Target In Selection
Target.Value = Application.WorksheetFunction.Proper(Target.Value)
Next

Else

End If

End Sub