VBA Macro to Loop through all Excel files in a Folder

How to Loop through all Excel[.xls] files in a Folder using VBA
 Sub Loop_Through_Xls_Files()
    Dim SourcePath As String
    Dim SourceFolder As Object
    Dim SrcFile As String
    Dim My_WB As Object
    
    Dim MyXlFiles() As String
    Dim FSO As Object
    Dim K As Integer
    
    Application.DisplayAlerts = False
    K = 1

'To Select the Target Folder by Opening the File Dialogue Box
   Set Flder_Picker = Application.FileDialog(msoFileDialogFolderPicker)
   
   With Flder_Picker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then Exit Sub 'Exit if we don't select a Folder
        MyPath = .SelectedItems(1) & "\"
    End With
  
  MsgBox MyPath

'Loop through each Excel File in the Target Folder and Storing in an Array
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    SourcePath = MyPath 
    Set SourceFolder = FSO.GetFolder(SourcePath)
          
    For Each File In SourceFolder.Files
    If InStr(File.Name, ".xls") Then
    
    ReDim Preserve MyXlFiles(K)
    MyXlFiles(K) = File.Name

    K = K + 1
    
    End If
    Next File
    
'Loop through specific Excel Files , Opening , Performing an Operation and Closing, from the SourcePath
    SrcFile = Dir(SourcePath & "SQL*.xls")
       
    Do While SrcFile <> ""               
        Set My_WB = Workbooks.Open(SourcePath & SrcFile, UpdateLinks:=False, ReadOnly:=True, Editable:=True)
         ' Your Macro operation here        
        MsgBox SrcFile 'My_WB.Name
        My_WB.Close
           
        SrcFile = Dir() 'Allows to Go to Next File in a Directory
    Loop
 End Sub

Thanks, TAMATAM

Excel VBA Pivot Table Standard Operations

Pivot Table Standard Operations with Excel VBA
Suppose we have a Pivot Table as Follows :

Pivot Field list as follows :

On the above Pivot Table , we can perform various standard basic operations using VBA as follows :

Sub Pivot_Operations()

Dim Pvt As PivotTable
Dim Pvt_GrandTotal As Range

For Each Pvt In ActiveSheet.PivotTables

If Pvt.Name = "Pivot_Main" Then
Set MyPivot = ActiveSheet.PivotTables(Pvt.Name)
End If

Next Pvt
--------------------------------------------------------- 
'Setting the Grand Totals On for Columns and Rows
    With MyPivot
        .ColumnGrand = True
        .RowGrand = True
    End With
--------------------------------------------------------- 
'Changing the Pivot Layout to Classic Pivot Model , Displaying the FieldCaptions(Prod_Id, Sales_Period)

With MyPivot
    .InGridDropZones = True
    .DisplayFieldCaptions = True
    .RowAxisLayout xlTabularRow
End With

'Showing the Details of All data. The following method works good on Classic Pivot Tables , we can  convert a Pivot to Classic Pivot using above method.

Set Pvt_GrandTotal = MyPivot.GetPivotData("Sum of Sales")
Pvt_GrandTotal.ShowDetail = True
--------------------------------------------------------- 
'Showing the Details of All data. This method is not working properly(Getting Runtime Error 438)
MyPivot.DataBodyRange.Select
RC = (Selection.Rows.Count) - 1
CC = (Selection.Columns.Count) - 1

ActiveCell.Offset(RC, CC).Select
Selection.ShowDetails = True
--------------------------------------------------------- 
'Counting the PivotFields(ReportFilters,RowLabels,ColumnLabels)
PFC = MyPivot.PivotFields.Count

'Looping Thorough Pivot Fields ( Row Lables ,Report Filter, Column Labels , Values )
For X = 1 To PFC
'Displaying the Pivot Field Name
MsgBox MyPivot.PivotFields(X).Name

If MyPivot.PivotFields(X).Name = "Sales_Period" Then
'Counting the PivotItems of a Desired PivotField
PIC = MyPivot.PivotFields(X).PivotItems.Count

'Displaying the PivotFiled Orientation[Row Field(Orientaion=1),Column Field(Orientaion=2)]
MsgBox MyPivot.PivotFields(X).Orientation

'Looping through the specific Pivot Filed Items
For Y = 1 To PIC

'Checking whether the Desired Pivot Field is a Row Field/Column Field
If MyPivot.PivotFields(X).Orientation = xlRowField Then

'To Select the Specified Field Item Data Range
MyPivot.PivotFields("X").PivotItems(1).DataRange.Select
GT = (Selection.Cells.Count) + 1 'Count of Pivot Item Values

'Getting the Pivot < Row Field Item > and its Grand Total Value
MyPivot.PivotFields(X).PivotItems(Y).LabelRange.Select
MsgBox Selection.Value  'Pivot Item
MsgBox ActiveCell.Offset(0, GT).Value  'Grand Total of the Pivot Item

Else ' If MyPivot.PivotFields(X).Orientation = xlColumnField

'To Select the Specified Field Item Data Range
MyPivot.PivotFields("X").PivotItems(1).DataRange.Select
GT = (Selection.Cells.Count) + 1 'Count of Pivot Item Values

'Getting the Pivot < Colum Field Item > and its Grand Total Value
MyPivot.PivotFields(X).PivotItems(Y).LabelRange.Select
MsgBox Selection.Value 'Pivot Item
MsgBox ActiveCell.Offset(GT, 0).Value 'Grand Total of the Pivot Item

End If

Next Y

End If

Next X
--------------------------------------------------------- 
'To select the Report Filter
MyPivot.PageRange.Select

'To select the Cell of Sum of Sales/Net Sales.
MyPivot.DataLabelRange.Select

'To Select the Column/Row Header Label < Sales_Period >/<Prod_Id>
MyPivot.PivotFields("Sales_Period").LabelRange.Select

'To Select the Column/Row Label Items
MyPivot.PivotFields("Sales_Period").DataRange.Select

'To Select the Particular Field Item Label
MyPivot.PivotFields("Sales_Period").PivotItems("Q3-2014").LabelRange.Select

'To Select the Particular Field Item Data Range
MyPivot.PivotFields("Sales_Period").PivotItems("Q3-2014").DataRange.Select

'To Select the Row Grand Totals with Label < Grand Total >
MyPivot.PivotSelect "'Row Grand Total'", xlDataAndLabel, True

'To Select the Column Grand Totals with Label < Grand Total >
MyPivot.PivotSelect "'Column Grand Total'", xlDataAndLabel, True

'To Select the Intersection Value of Row and Column Item.
Intersect(MyPivot.PivotFields("Prod_Id").PivotItems("CDE_3456").DataRange.EntireRow, _
MyPivot.PivotFields("Sales_Period").PivotItems("Q3-2014").DataRange).Select

'To Select the Row Labels Range
MyPivot.RowRange.Select

'To Select the Column Labels Range
MyPivot.ColumnRange.Select

'To select the Data Section including Grand Totals.
MyPivot.DataBodyRange.Select
--------------------------------------------------------- 
'Applying Filter on Row/Column/Filter PivotFields
    With MyPivot.PivotFields("Prod_Id")
        .PivotItems("BCD_2345").Visible = False
        .PivotItems("DEF_4567").Visible = False
        .PivotItems("FGH_6789").Visible = False
        .PivotItems("GHI_7890").Visible = False
    End With

'Clearing Filters from Row/Column/Filter PivotFields
MyPivot.PivotFields("Prod_Id").ClearAllFilters
--------------------------------------------------------- 
'Changing the DataPivotField Caption
MyPivot.DataPivotField.PivotItems("Sum of Sales").Caption = "Net_Sales"

'Adding a < Row Field > to a Pivot
    With ActiveSheet.PivotTables("Pivot_Main").PivotFields("Prod_Id")
        .Orientation = xlRowField
        .Position = 1
    End With

'Adding a < Column Field > to a Pivot
    With ActiveSheet.PivotTables("Pivot_Main").PivotFields("Sales_Period")
        .Orientation = xlColumnField
        .Position = 1
    End With

'Adding a < Report Filter > to a Pivot
    With ActiveSheet.PivotTables("Pivot_Main").PivotFields("Sales_Region")
        .Orientation = xlPageField
        .Position = 1
    End With

'Adding a Field in < Values Section > of a Pivot
    ActiveSheet.PivotTables("Pivot_Main").AddDataField ActiveSheet.PivotTables( _
        "Pivot_Main").PivotFields("Sales"), "Sum of Sales", xlSum
    
    ActiveSheet.PivotTables("Pivot_Main").AddDataField ActiveSheet.PivotTables( _
        "Pivot_Main").PivotFields("Sales_Region"), "Count of Sales_Region", xlCount

'Changing the Function of a Value Field in < Values Section > of a Pivot :
    With ActiveSheet.PivotTables("Pivot_Main").PivotFields("Sales")
        .Orientation = xlDataField
        .Caption = "Count the Sales"
        .Function = xlCount
        .Position = 1
        .NumberFormat = "#,##0"
    End With

    With ActiveSheet.PivotTables("Pivot_Main").PivotFields("Sales")
        .Caption = "Sum of Sales"
        .Function = xlSum
        .Position = 1
        .NumberFormat = "#,##0"
    End With
---------------------------------------------------------   
'Removing the Grand Totals for Columns an Rows
MyPivot.ColumnGrand = False
MyPivot.RowGrand = False

'To Remove the <Net Sales>/<Sum of Sales>/Data Section along with Grand Totals
MyPivot.PivotFields("Net_Sales").Orientation = xlHidden


End Sub

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

How to Calculate a Specific Range in Excel with VBA

Excel Macro to Calculate a Specific Range
Suppose we have a data as follows, where we have the Formulas in column C.

Now , we can refresh only the Range("A2:C5") as follows :

Sub Refresh_Range()
'To stop the workbook Calculation Manual
Application.Calculation = xlCalculationManual

'To Calculate Specified Range in a ActiveSheet
ActiveSheet.Range("A1:C5").Calculate

'To Calculate ActiveSheet
'ActiveSheet.Calculate

End Sub

Output :

What are Special Cells in Excel VBA

The SpecialCells Method in Excel VBA
The Special Cells in Excel are nothing but the Cells having the Formuls,Comments,Conditional Formatting and etc...
One of the most useful Methods in Excel is the SpecialCells Method. When use this method, it returns a Range Object that represents only those types of cells we specified.

The SpecialCells Method can be used in a wide variety of situations when you only need to work with cells having specific types of data.

For example, one can use the SpecialCells Method to return a Range Object that only contains only Visible Cells or Formulae.

Syntax of SpecialCells Method:
Expression.SpecialCells(Type, Value)

Where "Expression" must be a Range Object like Range("A1:C100"), ActiveSheet.UsedRange etc.

Type=XlCellType and can be one of these XlCellType constants.
xlCellTypeAllFormatConditions. 'Cells of any format
xlCellTypeAllValidation. 'Cells having validation criteria
xlCellTypeBlanks. 'Empty cells
xlCellTypeComments. 'Cells containing notes
xlCellTypeConstants. 'Cells containing constants
xlCellTypeFormulas. 'Cells containing formulas

xlCellTypeLastCell.   'The last cell in the used range.

Note this XlCellType will include empty cells that have had any of cells default format changed.
xlCellTypeSameFormatConditions. 'Cells having the same format
xlCellTypeSameValidation. 'Cells having the same validation criteria
xlCellTypeVisible. 'All visible cells

These arguments cannot be added together to return more than one XlCellType.

Value=XlSpecialCellsValue and can be one of these XlSpecialCellsValue constants.
xlErrors
xlLogical
xlNumbers
xlTextValues

These arguments can be added together to return more than one XlSpecialCellsValue.

The SpecialCells Method can be used in a wide variety of situations when you only need to work with cells having specific types of data.

For example, the code below would return a Range Object representing all formulae on the active Worksheet.

ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas)

If we wanted, we could narrow this down further to only return a Range Object representing of all formulae that are returning numbers.

ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas,xlNumbers)

Once we have the specific Range Object type returned we can then work with only those cells. 

This can often be done in one line of code, or you may need to Loop through the range as in below Examples:

Sub Color_All_Formulae_Cells()

    ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas).Interior.ColorIndex = 10

End Sub

Sub Negative_All_Number_Formulae()

Dim rRange As Range, rCell As Range

    Set rRange = ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas, xlNumbers)

     For Each rCell In rRange

        rCell = rCell.Value * -1

     Next rCell
End Sub

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

How to Filter Numbers Begins with In Excel and Copy the Filtered Range to a New Sheet

How to Filter a Column with Numbers Begins with or Starts with In Excel
Generally the Number Filters are look like as follows , where we do not have any option to Filter the Numbers starts with/begins with like "12***" or "21***" , as we have in Text Filters

Number Filters :

Text Filters :

In the above Text Filters , we have the Options like < Begins with > , < Ends with >.and we dont have any such options in Number Filters. 

But , still if we want to apply the Filter on a Numeric Column to Filter the Numbers starts with "12***" or "21***" , we have to do the following things :

First select the Numeric Column on which we want to apply the Filters.
Next , Change the data Format of Column and each Cell in Selection to Text using the below Code :

Selection.NumberFormat = "@"
For Each xCell In Selection
xCell.Value = CStr(xCell.Value)
Next xCell

Exit For
End If
Next X

Now the Numeric Column has been changed as Text based Column and we can see the Text Filters on that Column.



Example :
Suppose we have a Data follows int the < Master > Tab of a Workbook as follows :

In the above data, we have a Numeric Field called < Prod_Id > , from this Field, we wish to Filter Numbers starts with "12*" or "21*" and then copy this Filtered Range to a New sheet < Filtered_Prod_Id > .
This can be done using the below Macro :

Sub Trans_Filtered_Acct()

Dim WS As Worksheet
Dim New_WS As Worksheet

Set WS = ThisWorkbook.Sheets("Master")
WS.Activate

For X = 1 To 20
'Finding the <ACCT> Column Number Dynamically
If WS.Cells(1, X) = "Prod_Id" Then
C = Cells(1, X).Column
CN = Split(Cells(, c).Address, "$")(1)

Set LastDataCell = WS.Cells.Find("*", WS.Cells(1, 1), , , xlByRows, xlPrevious)
RC = LastDataCell.Row

'Selecting the the <Prod_ID> Column
WS.Range(CN & "1:" & CN & RC).Select
Selection.NumberFormat = "@"

'Converting the <Prod_ID> Column data to Text Format
For Each xCell In Selection
xCell.Value = CStr(xCell.Value)
Next xCell

Exit For
End If

Next X

'Applying Filter on <Prod_ID> Column
WS.Range(CN & "1").Select
Selection.AutoFilter Field:=3, Criteria1:="=12*", Operator:=xlOr, Criteria2:="=21*"

'Copying the All columns data in Filtered Range
'ActiveSheet.AutoFilter.Range.Copy

(or)

'Copying the Specific columns data in Filtered Range
Set MyRange = WS.Range("A1:D" & RC).SpecialCells(xlCellTypeVisible)
MyRange.Copy

'Adding a New Sheet(Filtered_Prod_Id) and Copying the Filtered <Prod_ID> data to it.
Set New_WS = Sheets.Add(After:=Sheets(Sheets.Count))
New_WS.Name = "Filtered_Prod_Id"
ActiveSheet.Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
ActiveSheet.Range("A1").Select
Application.CutCopyMode = False

'Coming back to <Prod_ID> tab and clearing the Filter
WS.Activate
WS.Range("A1").Select
Selection.AutoFilter
New_WS.Activate
Set WS = Nothing
Set New_WS = Nothing

MsgBox "Filtered <Prod_ID> Data has been Copied to a New Tab ", vbOKOnly, "Job Over"


End Sub

Output :

Thanks,TAMATAM

Passing Variable ByRef And ByVal in Excel VBA

Excel VBA ByRef and ByVal Syntax and Example

You can pass arguments to a Procedure (Function or Sub) By Reference or By Value. 

By default, Excel VBA passes arguments by reference. 

When we pass arguments By Reference , we are referencing the original value and value of the original value is changed in the Function.

When we pass arguments By Value , we are passing a copy to the function. The original value is not changed. 

Mehod-I : ByRef Example :

Sub By_Ref()

Dim X As Long

X = 20

MsgBox Cube_ByRef(X) ' Value of X after executed in Function

MsgBox  X  ' Initial/Original value of X

End Sub

Function Cube_ByRef(ByRef X As Long) As Long

X = (X * X * X)

Cube_ByRef = X

End Function

Output :

Value of X after executed in Function :

Initial/Original value of X :

As we used the ByRef method , the original value has been changed after executed in Function.

------------------------------------------------------------------------------------------------------------------------

Mehod-II : ByVal Example :

Sub By_Ref()

Dim X As Long

X = 20

MsgBox Cube_ByRef(X) ' Value of X after executed in Function

MsgBox  X  ' Initial/Original value of X

End Sub

Function Cube_ByVal(ByVal X As Long) As Long

X = (X * X * X)

Cube_ByVal = X

End Function

Output :

Value of X after executed in Function :

Initial/Original value of X :

As we used the ByVal method , the original value remain same and will not  change even after executed in Function.

Conclusion:

When we use the same variable in multiple instances in a Program blocks , still if we want to use the original value of the variable , we need to use the ByVal method.

Thanks, TAMATAM

Worksheet Event to AutoFill a Cell with a Default Value

How to Fill a Cell with a Default Value using Excel VBA Worksheet Event
Suppose we have a Worksheet where we are filling Employees Information as follows..

Here in the above Table , the Fields "Designation" , "Dept_Name" are Optional.  Now we want to enter a default value "Not Applicable" when you left a cell <Blank> or mentioned as 'NA'.

This can be done using the following WorkSheet Event as follows :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo ErrMsg:

'Event applicable only in Columns 2 and Column 3
If (Target.Column <> 2 And Target.Column <> 3) Then Exit Sub

If (Target.Offset(-1, 0).Value = "" Or LCase(Target.Offset(-1, 0).Value) = "na") Then
Target.Offset(-1, 0).Value = " Not Applicable "
End If

ErrMsg:
If Err.Number = 13 Then Exit Sub
End Sub

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

How to Get Combo box or Dropdown Index Value with Excel VBA

Excel VBA to Get Combo box or Dropdown Index Value
Suppose we have a Form Control Combobox or Dropdown lis as follows :

Now we can select or change or get the above Dropdown list Index Value with VBA Macro as follows :
Sub Form_Ctrl_Cmbo_DropDown()
Dim Form_Obj As Object
  'Assinging the DropDown/Combobox(Form Control) to a Object Variable
Set Form_Obj = ActiveSheet.DropDowns("MyDropDown")

'To Display the Count of List Items
MsgBox Form_Obj.ListCount
'To Change the List Index Position
Form_Obj.ListIndex = 3

'Method-I : Loop Through and Display DropDown(Form Control) Each List Index Value
    For J = 1 To Form_Obj.ListCount    
         MsgBox Form_Obj.List(J)
    Next J

'Method-II : To Display DropDown(Form Control) List Index and Value
MsgBox "The DropDown List Index Number : " & Form_Obj.ListIndex
MsgBox "The DropDown List Index Value : " & Form_Obj.List(Form_Obj.ListIndex)

'Method-III : To Display DropDown(Form Control) List Index and Value
With ActiveSheet.Shapes("MyDropDown").ControlFormat
MsgBox "Item Selected in DropDown = " & .List(.Value)
End With

End Sub
----------------------------------------------------------------------------------------
In the same way we can get the value of Active-X ComboBox values as follows :

Sub  ActivX_Cmbo_DropDown()
Dim OLE_Obj As Object
Set OLE_Obj = ActiveSheet.OLEObjects("MyCmb_Box").Object

'Counting the List of values in a Combo Box
MsgBox OLE_Obj.ListCount
'Passing the List Index Number to Combo Box
OLE_Obj.ListIndex = 4
'Displaying the List Index Value of Combo Box
MsgBox OLE_Obj.Value

Y = OLE_Obj.ListCount
MsgBox Y

'Looping through Combo box List items
For X = 0 To (Y - 1)
MsgBox OLE_Obj.List(X)
Next X
End Sub

Note :
Combobox List Index starts from 0, by defautlt, if you dont specify as Option Base 1

--------------------------------------------------------------------------------------------------------

Thanks, TAMATAM ; Business Intelligence & Analytics Professional 

--------------------------------------------------------------------------------------------------------

How to store All Opened Workbooks Names in an Array

VBA Macro to store All Opened Workbooks Names in an Array
Suppose we have 4 workbooks opened as follows :

Now you can store the Names of all these workbooks opened , using the below Macro :
Sub Opened_WB_Names()
Dim WB_Names() As String

WB_Count = Workbooks().Count

For X = 1 To WB_Count

ReDim Preserve WB_Names(X - 1)

WB_Names(X - 1) = Workbooks(X).Name

'MsgBox WB_Names(X - 1)

Next X
End Sub

Thanks,TAMATAM