VBA Files Exists in the Selected Folder

!...VBA program to Display All the files in the Selected folder with name,filepath,size of file etc...!

Sub File_Names_infolder()
Dim fso As Scripting.FileSystemObject
Dim fld, fil As Object
Dim i As Integer
i = 1
Set fso = CreateObject("scripting.filesystemobject")
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Select Analyfolder"
.Show
End With
Set fld = fso.GetFolder(Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1))
For Each fil In fld.Files
Cells(i, 1).Value = fil.Path
Cells(i, 2).Value = fil.Name
Cells(i, 3).Value = Left(fil.Name, Application.WorksheetFunction.Find(".", fil.Name) - 1)
Cells(i, 4).Value = Round(fil.Size / 1024)
i = i + 1
Next fil
End Sub

Important Functions in VBA

!...Some Important Functions in Excel-VBA....!

Debug.Print StrReverse("abcdefghijklmnopqrstuvwxyz") '''' Reverse a String
Debug.Print UCase("amit verma") '' Print String in Upper Case
Debug.Print LCase("AMIT VERMA") '' Print String in Upper Case
Debug.Print Replace("amit verma", " ", "") '' Replace Space with null Values
Debug.Print IsNumeric(12305) ''' Function True if given value is numerice either false
Debug.Print MonthName(10) '' Print the Monthname of the given value
Debug.Print Format(Now, "dd-mmm-yyyy") '' Function display only Date in the given format
Debug.Print Format(Now, "hh:mm:ss") '' Function display only Time in the given format
Debug.Print Asc("a") '' Displays Ascii Value of the give character
Debug.Print Chr(85) '' Displays character from the basis of given number
Debug.Print CDate("12 feb 2013") '' Converts a String into Date
Debug.Print IsObject(Object) '' print true if the given values is object either false
Debug.Print IsEmpty(abc) ''print true if the given values is empty either false
Debug.Print IsError("#N/A") ''print true if the given values is error either false
Debug.Print InputBox("Enter Any Value") '' To Take user's Input
x = MsgBox("Do U Want to Run Again", vbYesNoCancel) '' Message Box & Properties
Debug.Print x
Debug.Print LTrim("     akshay") '' Remove spaces from the left
Debug.Print RTrim("akshay     ") '' Remove spaces from the left
Debug.Print Trim("    akshay     ") '' Remove leading & trailing spaces from the left
Shell "notepad" '' To open installed applications on your system
MkDir "E:\abc" '' Creates directory in E: drive with the name ABC
RmDir "E:\abc" '' Removes directory in E: drive with the name ABC
Kill "e:\*.xls" '' Delete All the file in the E: directory with ".xls" extension
FileCopy "E:\abc\xyz.xls", "E:\" '' Copy "xyz.xls" file to E: drive
Name "D:\VIKAS DATA\VBA PROGRAMMING\excel macros\testing.xls" As "D:\VIKAS DATA\VBA PROGRAMMING\testing.xls" '' Move/Rename file
Range("a1:z20").Select '' Function Selects the cells A1:Z20 in the activesheet
Workbooks.Open "E:\abc.xls" '' To Open another Excel File
Cells(1, 1).Select '' Selects 1st cell and 1st column in the activesheet
Sheets("abc").Select ''' Selects the sheet whose name "abc"
Worksheets("abc").Select ''' Selects the sheet whose name "abc"
ActiveWorkbook.Sheets("abc").Select ''' Selects the sheet whose name "abc"
ActiveWorkbook.Worksheets("abc").Select ''' Selects the sheet whose name "abc"
result = Application.WorksheetFunction.CountIf(Range("a:a"), ">10") '' Use Excel worksheetfunction like this in VBA
Cells.ClearContents '' This Will Clear All the Contents in Current Sheet
Sheets.Add.Name = "New Workbook" '' Add new sheet with the Name="New Workbook"

VBA to Change Sheet Tab Color

!.... VBA program to Change the Sheets Tab Color.....!

Sub Change_Sheettab_Color()

For i = 1 To 56

Sheets.Add.Name = i

Sheets(i).Tab.ColorIndex = i

ActiveSheet.Next.Select

Next

End Sub

Excel VBA Programming in VBScript

'''' Note copy the Whole Script and paste into notepad and save the notepad file with "filename.vbs" extension and click the saved notepad file to run Vbscript

Dim xl, y
set xl=createobject("Excel.application")
xl.visible=1
xl.workbooks.add
call add_sheets

Sub add_sheets()
Dim sname
If MsgBox("Do you Want to Add More Sheets", vbYesNo) = vbYes Then
sname = InputBox("Enter the Name for New Sheet")
xl.Sheets.Add.Name = sname
Else
Exit Sub
End If
Call add_sheets
End Sub

VBA Autorun Macros

!... VBA program to schedule your Macro at specific time frame.......!

Sub Autorun_Macro()
Application.OnTime Now + TimeValue("00:00:10"), "Unhide_AllSheets" '''' Macro Automatically Runs when Current time exceeds 10 Seconds
Application.OnTime TimeValue("16:45:20"), "Unhide_AllSheets" '''' Macro Automatically Runs when the Given Time Reached
End Sub

VBA to Unhide/Show All Sheets

!....VBA program to Unhide all Sheets in the Active Workbook....!

Sub Unhide_AllSheets()
Dim wb As Worksheet
For Each wb In Worksheets
wb.Visible = 1
Next wb
End Sub

Sub AllSheets_Unhide()
For i = 1 To Worksheets.Count
Sheets(i).Visible = 1
Next
End Sub

Sub Show_AllSheets()
Dim i
i = 1
While i <= Sheets.Count
Worksheets(i).Visible = True
i = i + 1
Wend
End Sub

VBA Data Sort Using Cell Background Color

!....VBA Program to Sort Data by Cell Background Color....!

Sub Sort_by_FontColor()
Application.ScreenUpdating = 0
Columns("b").Insert
For i = 2 To Range("a65536").End(xlUp).Row
Cells(1, 2) = "Color Index"
Cells(i, 2) = Cells(i, 1).Font.ColorIndex
Next
Range("a2:" & Chr(64 + Cells(1, 1).End(xlToRight).Column) & Range("A1").End(xlDown).Row).Sort Range("b2"), xlAscending
Columns("b").Delete
End Sub