Wednesday, January 30, 2013

How to Find First Occurrence of a String Based On Multiple Criteria

Excel VBA Macro To Know First Occurrence of a String Based On Multiple Criteria
Criteria:
'Suppose If You Have a Data with Ranges as 'ID','Start_Date','Week','Month','End_Date'
'And You Want to find the End_Date[Dead Line] for an ID with Week='Sunday' or 'Monday'
'And This Week Should be the First Occurred week and Should occur only once for the Same ID With Month Names as 'JAN' or 'FEB' or 'MARCH', In Such Cases......This Macro Will Help You.
'Dynamic Multi-Purpose Macro'
Sub MultiCrit_FirstOccur_Macro()
Dim X As Long
Dim Y As Long
Dim Z As Long

Dim I As Long

Dim J As Long
Dim K As Long
Dim LB As Long
Dim UB As Long

Dim A As Long

Dim B As Long

'My Sample Ranges

Dim ID As Object
Dim Week As Object
Dim Month As Object
Dim Start_Date As Object
Dim End_Date As Object
Dim Code As Object

Dim MaxDate As String

Dim MinDate As Date
Dim WSF As WorksheetFunction
Dim MyDate() As Date
Dim TempStr As Date
'------------------------------------------------------------------------------------------
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'------------------------------------------------------------------------------------------
Dim RC As Long 'All Rows Count
Dim CC As Long 'All Columns Count
Dim NBRC_Main As Long 'Non Blank Rows Count In Main[Data] Sheet
Dim NBRC_Sub As Long 'Non Blank Rows Count In Sub[Result] Sheet

RC = ThisWorkbook.ActiveSheet.Rows.Count

CC = ThisWorkbook.ActiveSheet.Columns.Count
'------------------------------------------------------------------------------------------
'Defining Column Headers As List/Range Names for Each Column In Main Sheet
On Error Resume Next
ThisWorkbook.Sheets("Data").Activate
For X = 1 To 50
If ThisWorkbook.Sheets("Data").Cells(1, X) <> "" Then Cells(1, X).EntireColumn.Select
Selection.Name = Cells(1, X).value
Next X
'------------------------------------------------------------------------------------------
'Defining Dynamic Ragne Names
Set ID = ThisWorkbook.Names("ID").RefersToRange.Cells
Set Start_Date = ThisWorkbook.Names("Start_Date").RefersToRange.Cells
Set End_Date = ThisWorkbook.Names("End_Date").RefersToRange.Cells
Set Month = ThisWorkbook.Names("Month").RefersToRange.Cells
Set Week = ThisWorkbook.Names("Week").RefersToRange.Cells
Set Code = ThisWorkbook.Names("Code").RefersToRange.Cells
'------------------------------------------------------------------------------------------
Z = 0
For X = 2 To RC 
If ThisWorkbook.Sheets("Result").Cells(X, 1).value <> "" Then
ReDim MyDate(Z)
For Y = 2 To RC

'Criteria:
'My ID should match to an ID in a Range - ID
'My Month shoud Match to any of 3[JAN or FEB or MARCH] Months of a Range - Month

If ThisWorkbook.Sheets("Result").Cells(X, 1).value = ID.Rows(Y).value And (Month.Rows(Y).value = "JAN" _Or Month.Rows(Y).value = "MAR" Or _

Month.Rows(Y).value = "FEB") Then
'If The Above Criteria Matches Then Store Corresponding Strat_Date Values In Array
MyDate(Z) = Start_Date.Rows(Y).value
Z = Z + 1
'Reintializing Array Size
ReDim Preserve MyDate(Z)
End If
Next Y

End If

'------------------------------------------------------------------------------------------
'Sorting Date Values Stored In An Array to Know Earliest/First Occurance Date
LB = LBound(MyDate)
UB = UBound(MyDate)
    For I = LB To UB - 1
        For J = I + 1 To UB
            If MyDate(I) > MyDate(J) Then
                TempStr = MyDate(J)
                MyDate(J) = MyDate(I)
                MyDate(I) = TempStr
            End If
        Next J
    Next I
    
MinDate = MyDate(LBound(MyDate) + 1) 'Minimu Date Value Stored In An Array
'------------------------------------------------------------------------------------------
If ThisWorkbook.Sheets("Result").Cells(X, 1).value <> "" Then
'Minimum Corresponding Date Of the Matched Criteria
ThisWorkbook.Sheets("Result").Cells(X, 2).value = MyDate(LBound(MyDate) + 1)
'Maximum Corresponding Date Of the Matched Criteria
ThisWorkbook.Sheets("Result").Cells(X, 3).value = MyDate(UBound(MyDate))
End If
'------------------------------------------------------------------------------------------
'Again Looping to Check another Criteria In My Matched Criteria
K = 0
For A = 1 To RC
'Criteria:
'My ID should match to an ID in a Range - ID
'My Week shoud Match to any of 2[Sunday or Monday ] Weeks of a Range - Week
'And  The Week either 'Sunday' or 'Monday' Should Exist For one ID only once

If (ThisWorkbook.Sheets("Result").Cells(X, 1).value = ID.Rows(A).value) And _

(Week.Rows(A).value = "Sunday" Or Week.Rows(A).value = "Monday") Then
K = K + 1 'Count The Matched Criteria Which Should Be 0> and <=2
End If
Next A
'Loop to check whether the Week - 'Sunday' or 'Monday' for the Same ID Occured First and only once.
For B = 1 To RC
If (K <> 0) And (K <= 2) Then
If (ThisWorkbook.Sheets("Result").Cells(X, 1).value = ID.Rows(B).value) And _
(Start_Date.Rows(B).value = MinDate) And (Week.Rows(B).value = "Sunday" Or Week.Rows(B).value = "Monday") Then
ThisWorkbook.Sheets("Result").Cells(X, 4).value = K
ThisWorkbook.Sheets("Result").Cells(X, 5).value = End_Date.Rows(B).value
End If
End If
Next B
Z = 0
Next X

'------------------------------------------------------------------------------------------
Application.DisplayAlerts = True
ThisWorkbook.Sheets("Result").Activate
End Sub

Thanks,TAMATAM

Monday, January 28, 2013

How to Find difference of Maximum and Minimum Dates using Arrays in Excel VBA

Excel VBA Macro to Find difference of Maximum and Minimum Dates using Array
Option Explicit
Sub Arrayz_Dates()
Dim X As Long
Dim Y As Long
Dim Z As Long

Dim I As Long

Dim J As Long
Dim K As Long
Dim LB As Long
Dim UB As Long

Dim Start_Date As Range

Dim End_Date As Range
Dim Max_Start_Date As Range
Dim Min_Start_Date As Range
Dim Difference As Range

Dim MyDate() As Date

Dim TempStr As String

Dim RC As Long 'All Rows Count

Dim CC As Long 'All Columns Count

RC = ThisWorkbook.ActiveSheet.Rows.Count
CC = ThisWorkbook.ActiveSheet.Columns.Count

Set Start_Date = ThisWorkbook.Names("Start_Date").RefersToRange.Cells

Set End_Date = ThisWorkbook.Names("End_Date").RefersToRange.Cells
Set Max_Start_Date = ThisWorkbook.Names("Max_Start_Date").RefersToRange.Cells
Set Min_Start_Date = ThisWorkbook.Names("Min_Start_Date").RefersToRange.Cells
Set Difference = ThisWorkbook.Names("Difference").RefersToRange.Cells
'--------------------------------------------------------
Z = 0
' Looping Through Checking Multiple Criteria In  List/Range Names'
For X = 2 To RC 'You can Use RC[All Rows Count] But Macro Becomes Very Slow
If Start_Date.Rows(X).value <> "" Then
Z = Z + 1
'Reintializing Array Size
ReDim Preserve MyDate(Z)
MyDate(Z) = Start_Date.Rows(X).value
End If
Next X
'--------------------------------------------------------
'Sorting Values Stored In An Array
LB = LBound(MyDate)

UB = UBound(MyDate)
    For I = LB To UB - 1
        For J = I + 1 To UB
            If MyDate(I) > MyDate(J) Then
                TempStr = MyDate(J)
                MyDate(J) = MyDate(I)
                MyDate(I) = TempStr
            End If
        Next J
    Next I
Max_Start_Date.Rows(2).value = MyDate(UBound(MyDate))
Min_Start_Date.Rows(2).value = MyDate(LBound(MyDate) + 1)
Difference.Rows(2).value = MyDate(UBound(MyDate)) - MyDate(LBound(MyDate) + 1)
End Sub

Thanks,TAMATAM

Sunday, January 27, 2013

Excel VBA Dynamic Multi-purpose Macro

Macro to define List/Range Names for Each Column with Column headings and then Filter the Unique Records based on a Column['ID'] of the Main Sheet and Copy those Unique Records to Sub Sheet and then Store those Records in an Array and then Sort and Find the Latest records by Date..then Fulfill the Criteria.The Following is a Most Powerful and Dynamic Macro can be used in a efficient manner for various criteria.
Features of This Macro:
> This Macro Defines List/Range Names for Each Column with Column heading as List Name.
>These List Names we can use as dynamic ranges.
>This Macro Filter the Unique Records based on I-Column['ID'] of the Main Sheet and Copy those Unique Records to Sub Sheet ,We can use these Unique records for our criteria building.
>This macro dynamically full fill your requirement based on criteria builded by you.
>The macro is builded in a new and very dynamic approach.

Sub DynamicMacro()

Dim X As Long
Dim Y As Long
Dim Z As Long

Dim I As Long

Dim J As Long
Dim LB As Long
Dim UB As Long

'My Sample Ranges
Dim ID As Range
Dim Product As Range
Dim Division As Range
Dim Start_Time As Range
Dim Action As Range

Dim MaxDate As String

Dim MinDate As String
Dim WSF As WorksheetFunction
Dim MyDate() As Date
Dim TempStr As Date

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim RC As Long 'All Rows Count
Dim CC As Long 'All Columns Count
Dim NBRC_Main As Long 'For Non Blank Rows Count In Main[Data] Sheet
Dim NBRC_Sub As Long 'For Non Blank Rows Count In Sub[Result] Sheet

RC = ThisWorkbook.ActiveSheet.Rows.Count

CC = ThisWorkbook.ActiveSheet.Columns.Count

'Defining Column Headers As List/Range Names for Each Column In Main Sheet
On Error Resume Next
ThisWorkbook.Sheets("Main").Activate
For X = 1 To CC
If ThisWorkbook.Sheets("Main").Cells(1, X) <> "" Then Cells(1, X).EntireColumn.Select
Selection.Name = Cells(1, X).value
Next X

'Defining Dynamic Ragne Names
Set ID = ThisWorkbook.Names("ID").RefersToRange.Cells
Set Start_Date = ThisWorkbook.Names("Start_Date").RefersToRange.Cells
Set End_Date = ThisWorkbook.Names("End_Date").RefersToRange.Cells
Set Division = ThisWorkbook.Names("Division").RefersToRange.Cells
Set Product = ThisWorkbook.Names("Product").RefersToRange.Cells
Set Units = ThisWorkbook.Names("Units").RefersToRange.Cells
Set Price = ThisWorkbook.Names("Price").RefersToRange.Cells
Set Revenue = ThisWorkbook.Names("Revenue").RefersToRange.Cells

'Filtering Data In Main Sheet By ID , Copy Unique ID's and Paste In I-Column of Sub Sheet
ThisWorkbook.Sheets("Main").Activate
ActiveSheet.Range("A1").Select
Selection.AutoFilter
ActiveSheet.Range("ID").AdvancedFilter Action:=xlFilterInPlace, Unique:=True
ActiveSheet.Columns("A:A").Select
Selection.Copy
ThisWorkbook.Sheets("Sub").Activate
ActiveSheet.Range("A1").Select
ActiveSheet.Paste
ActiveSheet.Range("A1").Select
ThisWorkbook.Sheets("Main").Activate
ActiveSheet.Range("A1").Select
Application.CutCopyMode = False
ActiveSheet.ShowAllData
Selection.AutoFilter

'Non Blank Rows Count to Use in our Loops to Reduce Loop TAT [Turn Around Time]For X = 1 To RC
If ThisWorkbook.Sheets("Main").Cells(X, 1) <> "" Then
NBRC_Main = NBRC_Main + 1 'Non Blank Rows Count Based I-Column In Main Sheet
End If
If ThisWorkbook.Sheets("Sub").Cells(X, 1) <> "" Then
NBRC_Sub = NBRC_Sub + 1 'Non Blank Rows Count Based I-Column In Sub Sheet
End If
Next X

' Looping Through Checking Multiple Criteria In  List/Range Names'
For X = 2 To NBRC_Sub 'Youcan Use RC[All Rows Count] But Macro Becomes Very Slow
ReDim MyDate(0)

If ThisWorkbook.Sheets("Sub").Cells(X, 1).value <> "" Then

For Y = 2 To NBRC_Main
If ThisWorkbook.Sheets("Sub").Cells(X, 1).value = ID.Rows(Y).value _
And (Division.Rows(Y).value = "String" Or Division.Rows(Y).value = "Electronic") And _
Product.Rows(Y).value = "Keyboard" Then
ThisWorkbook.Sheets("Sub").Cells(X, 3).value = ThisWorkbook.Sheets("Sub").Cells(X, 3).value + Units.Rows(Y).value

'Reintializing Array SizeMyDate(Z) = Start_Date.Rows(Y).value
Z = Z + 1
'Reintializing Array Size
ReDim Preserve MyDate(Z)
ThisWorkbook.Sheets("Sub").Cells(X, 2).value = Z
End If
Next Y

End If


'Sorting Values Stored In An Array
LB = LBound(MyDate)
UB = UBound(MyDate)
    For I = LB To UB - 1
        For J = I + 1 To UB
            If MyDate(I) > MyDate(J) Then
                TempStr = MyDate(J)
                MyDate(J) = MyDate(I)
                MyDate(I) = TempStr
            End If
        Next J
    Next I

ThisWorkbook.Sheets("Sub").Cells(X, 4).value = MyDate(UBound(MyDate)) 'Maximum Date Value Stored In An Array
ThisWorkbook.Sheets("Sub").Cells(X, 5).value = MyDate(LBound(MyDate) + 1) 'Minimum Date Value Stored In An Array
Z = 0
Next X

Application.DisplayAlerts = True
ThisWorkbook.Sheets("Sub").Activate
End Sub

--------------------------------------------------------------------------------------------------------
Thanks, TAMATAM ; Business Intelligence & Analytics Professional
--------------------------------------------------------------------------------------------------------

Tuesday, January 22, 2013

How to Open a Dialog Box to Select a File and Copy desired Columns using VBA Marco

Excel VBA Macro to Open a Dialog Box to Select a Target File and Copy  Desired Columns which Match with the our  Workbook Columns
Sub CopyDesiredCols()
Dim TargetFile As Variant
Dim TargetFileName As Variant
Dim Ws As Worksheet
Dim X As Long
Dim Y As Long
Dim Z As Long

Y = ActiveSheet.Columns.Count

TargetFile = Application.GetOpenFilename("Excel Files, *.xls;*.xlsx;*.xlsm", , "Select Your File")

'If TargetFile = False Then Exit Sub


Workbooks.Open (TargetFile)

TargetFileName = ActiveWorkbook.Name
Workbooks(TargetFileName).Activate

For X = 2 To Y

If ThisWorkbook.Sheets("Mydata").Cells(1, X) <> "" Then

For Z = 2 To Y
If LCase(ThisWorkbook.Sheets("Mydata").Cells(1, X)) = LCase(ActiveWorkbook.Sheets("Database").Cells(1, Z)) Then
ActiveWorkbook.Sheets("Database").Cells(1, Z).EntireColumn.Select
Selection.Copy
ThisWorkbook.Sheets("Mydata").Cells(1, X).PasteSpecial Paste:=xlPasteValues
End If
Next Z

End If

Next X

Workbooks(TargetFileName).Save

Workbooks(TargetFileName).Close
MsgBox "DATA Succesfull Copied From " & " " & TargetFileName & vbNewLine _
& "You Can Select Next File", vbInformation, "Success !!!"
Exit Sub

Err:

MsgBox Err.Description
End Sub

Thanks, Tamatam

Sunday, January 20, 2013

How to Convert Column Headings as List Names or Range Names with Excel VBA Macro

Excel VBA Macro To Create List Names  or Range Names with Column Headings as they refers List Names for Respective Columns
Sub ColHeaderAsList()
Dim X As Long
Dim Y As Long
On Error Resume Next
Y = ActiveSheet.Columns.Count

For X = 1 To Y    'You can reduce this loop size as you wish
If Cells(1, X) <> "" Then Cells(1, X).EntireColumn.Select
Selection.Name = Cells(1, X).value
Next X

MsgBox "List Names are Created With Columns Headings", , "Successfull !!!"
End Sub

Example:

Sample Data



Output :
List Names / Range Names






Regards,TAMATAM

Friday, January 18, 2013

How to Update Main Workbook Data Sheets with respective Sheets Data of Sub Workbook

Excel VBA Macro to Update Main Workbook Data Sheets with respective Sheets Data of Sub Workbook.
Scenario :
'The Main[This Workbook]workbook has the following Sheets In Some Jumble Order -
'Rawdata,SalesbyCountry,Sheet1,Sheet3,Sheet2,SalebyCustomer,PivotData,,,Sheet4,
'The Sub[Selected Workbook]workbook has the following Sheets In Some Jumble Order -
'Rawdata,Sheet1,PivotData,Sheet2.
'Now the Macro will update the data in Worksheets of the Main workbook which are Match 'with the Names of the Subworkbook.
'i.e., The Sheets-'Rawdata,Sheet1,PivotData,Sheet2' of Main workbook only will update.

Sub UpdateRespectiveSheets()

Dim MyFile As Variant
Dim MyFileName As String
Dim Ws As Worksheet
Dim SheetIndex As Integer

Application.DisplayAlerts = False

Application.ScreenUpdating = False

On Error GoTo Label1:

SheetIndex = 1
MyFile = Application.GetOpenFilename("Excel Files, *.xls;*.xlsx;*.xlsm")
Workbooks.Open (MyFile)
MyFileName = ActiveWorkbook.Name

For Each Ws In ActiveWorkbook.Sheets

Ws.Activate
For SheetIndex = 1 To ThisWorkbook.Sheets.Count
If ActiveSheet.Name = ThisWorkbook.Sheets(SheetIndex).Name Then
ActiveWorkbook.ActiveSheet.Cells.copy
ThisWorkbook.Sheets(SheetIndex).Range("A1").PasteSpecial
End If
Next SheetIndex
Next Ws

Workbooks(MyFileName).Activate

ActiveWorkbook.Save
ActiveWorkbook.Close
MsgBox "Success Fully Updated Data From Respecitve Sheets", vbInformation, "Success !!!"

Exit Sub

Label1:
MsgBox "Macro Failed/File Selection Cancelled", vbOKCancel, "FailedCancelled !!!"
MsgBox Err.Description 
End Sub

Thanks, TAMATAM

Thursday, January 17, 2013

How to Create a Dialog Box To Select and Merge Multiple Workbooks into Main Workbook

Excel VBA Macro to Open Dialog Box To Select and Merge Multiple Workbooks into Target Workbook
'This is Very User Friendly Macro that allows you to Merge Multiple Workbooks Selected from a open Dialog Box Into Our Workbook'

Sub CombineWorkbooks()

    Dim FilesToOpen As Variant
    Dim X As Integer

    On Error GoTo ErrHandler

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    FilesToOpen = Application.GetOpenFilename
 (FileFilter:="Microsoft Excel Files (*.xls*), *.xls*",MultiSelect:=True, Title:="Files to Merge")

    If TypeName(FilesToOpen) = "Boolean" Then

        MsgBox "No Files Were Selected"
        GoTo ExitHandler
    End If

   X = 1

    While X <= UBound(FilesToOpen)
        Workbooks.Open Filename:=FilesToOpen(x)
        Sheets().Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        + 1
    Wend
    
ExitHandler:
    Application.ScreenUpdating = True
    Exit Sub

ErrHandler:

    MsgBox Err.Description, vbCritical, "Error"
    Resume ExitHandler
End Sub

Thanks,Tamatam
  

Wednesday, January 16, 2013

Excel VBA Macro to Open a Dialog Box to Select a File and Copy All Sheets Into Main WorkBook

Excel VBA Macro to Open a File Dialog Box to Select a File and Copy All Sheets Into Target WorkBook
'Macro To Open a Dialog Box to Select a File and Dump All Sheets Into Our Work Book.
'All The Sheets are dumped in to our work book with respective sheet names and data.
'This is a very user friendly and powerful macro.
Option Explicit

Sub OpenDialogCopyFile()

Dim MyFile As Variant
Dim MyFileName As String
Dim Ws As Worksheet
Dim SheetIndex As Integer

Application.DisplayAlerts = False

Application.ScreenUpdating = False

On Error GoTo Err1:

SheetIndex = 1
MyFile = Application.GetOpenFilename("Excel Files, *.xls;*.xlsx;*.xlsm")

'If MyFile = False Then Exit Sub


Workbooks.Open (MyFile)

MyFileName = ActiveWorkbook.Name

For Each Ws In ActiveWorkbook.Sheets

Ws.Activate
ActiveSheet.Copy After:=ThisWorkbook.Sheets(SheetIndex)
'Add Each sheet of selected file after first sheet of our file
SheetIndex = SheetIndex + 1
Next Ws

Workbooks(MyFileName).Activate

' Selected File Saving and Closing after Copied
ActiveWorkbook.Save
ActiveWorkbook.Close
MsgBox "Success Fully Copied Selected Workbook", vbInformation, "Success !!!"
Exit Sub
Err1:
'If you cancel file selection / macro fails to run...then kick you this msgbox
MsgBox "Macro Failed/File Selection Cancelled", vbOKCancel, "Failed/Cancelled !!!"
End Sub

Thanks,
TAMATAM

Friday, January 11, 2013

How to Display Latest Modified File Name in a Specified Path using VBA Macro

Excel VBA Macro to display the Latest Modified File Name in a Specified Path
Suppose You have Copied a File from a Location to Your Desired Path or You have Modified a File in Your Desired Path , Up to so long time you didn't do any modifications in that Path, Now after so long time You want to know the File Name That You Modified Latest , Now You can find it , by using this Macro.

Note: 
This Macro will show only the latest Modified .i.e.the file that you modified recently.
-----------------------------------------------------------------------------------
Model- I :
Sub Latest_Modified_File()

Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim StrPath As String
Dim StrName As String
Dim LModDate As Date

On Error GoTo Label1:

' Specifying File Path To Find Latest Modified File:

StrPath = InputBox("Enter Path of Latest Modified File To Open " & vbNewLine _
& "Eg: D:\Excel_VBA ", "File Path")

' Using Microsoft Scripting Runtime.
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(StrPath)

' Check date of each File in Folder:
For Each objFile In objFolder.Files
If objFile.DateLastModified > LModDate Then

LModDate = objFile.DateLastModified

StrName = objFile.Name
End If
Next 'objFile

' Displaying Latest Modified File name in Specified Path:
MsgBox StrName & " - Is The latest File Modified On = " & LModDate & vbNewLine _
& "Doucment Path:" & StrPath, vbInformation, "Lastest Modified Document"

Set objFSO = Nothing
Set objFolder = Nothing
Set objFile = Nothing

Label1:
End Sub
-----------------------------------------------------------------------------------

Model- II :
Sub Latest_Modified_File()

Dim StrFile As String
Dim StrPath As String
Dim LatDt As Date
Dim LMFile As String

StrPath = InputBox("Enter Path of Latest Modified File" & vbNewLine _
& "Eg: D:\Excel_VBA\ ", "File Path")

StrFile = Dir(StrPath & "*.*", vbNormal)

Do While StrFile <> ""
      If FileDateTime(StrPath & StrFile) > LatDt Then
           LatDt = FileDateTime(StrPath & StrFile)
           LMFile = StrFile
      End If
   StrFile = Dir
Loop

MsgBox "Last Modified File is : " & LMFile & " , " & "Modified On :" & LatDt

End Sub

Note:
This Macro will show only the latest Modified .i.e.the file that you modified recently.

-------------------------------------------------------------------------------------------------------
Thanks, TAMATAM ; Business Intelligence & Analytics Professional 
--------------------------------------------------------------------------------------------------------

Excel VBA Macro to List All Files in a Desired Path

How to List All the Files in a Specified Directory using Excel VBA Macro
'This Macros List out all the Files Names in a Column beginning from Active Cell of an Active Sheet
      Sub ListAllFiles()

      Dim Files As String
         Files = Dir("C:\Users\Tamatam\Desktop\Temp\*.*")

         Do While Len(Files) > 0
               ActiveCell.Formula = Files
               ActiveCell.Offset(1, 0).Select
               Files = Dir()
         Loop

      End Sub
-------------------------------------------------------------------------------------------
Specific Files Type Case (.xls..):
Macro to List All The Excel[.xlsx] Files Names in a Specified Path
'This Macros List out all the Excel[.xls,.xlsx,.xlsm'] Files Names in a Column Beginning From Active Cell of an Active Sheet
      Sub ListAll_Xls_Files()

      Dim Files As String
         Files = Dir("C:\Users\Tamatam\Desktop\Temp\\*.xls*")

         Do While Len(Files) > 0
               ActiveCell.Formula = Files
               ActiveCell.Offset(1, 0).Select
               Files = Dir()
         Loop

      End Sub

Note:
You can use this macro to list out any files type from any desired path in your PC.
--------------------------------------------------------------------------------------------------------
Thanks, TAMATAM ; Business Intelligence & Analytics Professional
--------------------------------------------------------------------------------------------------------

Monday, January 7, 2013

How to Convert Cell Values To Hyper Links using Excel VBA Macro

Excel VBA Macro to Convert Cell Values To Hyper Links
The following Macro will Convert the Cell Values of Range ['A1:A100'] to Hyperlinks
Sub Convert_To_Hyperlinks()
Dim x As Integer
For x = 1 To 100

If Cells(x, 1) <> "" Then Cells(x, 1).Select

ActiveSheet.Hyperlinks.ADD Anchor:=Selection, _
Address:=Cells(x, 1).value, TextToDisplay:=Cells(x, 1).value
'Adress:="www.google.com",TextToDisplay:="Google"

End If

Next x

End Sub

Th@nks..Tamatam
    

Thursday, January 3, 2013

Excel VBA Macro to Delete Sheets Based on Their Tab Color

Excel VBA Macro to Delete Sheets Based on Their Tab Color
The following Macro will Delete the Sheets having Red[255] Color
Sub DelTabColor()

For Each ws In ThisWorkbook.Worksheets
ws.Activate
If ws.Tab.Color = 255 Then
ws.Delete
End If
Next ws

End Sub

Thanks,Tamatam

Excel VBA Macro to Convert Excel Formulas to Values In Each Sheet

Excel VBA Macro to Convert Excel Formulas to Values In Each Sheet
Sub ConvF2V()
Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets

ws.Activate
ActiveSheet.Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Next ws

End Sub


Thanks, TAMATAM

Featured Post from this Blog

How to compare Current Snapshot Data with Previous Snapshot in Power BI

How to Dynamically compare two Snapshots Data in Power BI Scenario: Suppose, we have a sample Sales data, which is stored with Monthly Snaps...

Popular Posts from this Blog