How to Hide or Unhide the Specific Sheets with Excel VBA Macro

Excel VBA Macro to Hide or Unhide the Specific Sheets
Let us suppose we have some sheets like...MyReports,My_Links,SLA_Report,Calls_Info in our Workbook.
If you want to Hide or UnHide when Click a Button , you have to assign the Macro to a Button.

Sub Hide_UnHide_TABS()
On Error Resume Next
Application.ScreenUpdating = False

'UnHide if Hideen
    If Sheets("MyReports").Visible = False Or Sheets("My_Links").Visible = False Or _
            Sheets("SLA_Report").Visible = False Or Sheets("Calls_Info").Visible = False Then
            Sheets("MyReports").Visible = True: Sheets("My_Links").Visible = True
            Sheets("SLA_Report").Visible = True: Sheets("Calls_Info").Visible = True
  
 'Hide if  UnHide
    ElseIf Sheets("MyReports").Visible = True Or Sheets("My_Links").Visible = True Or _
            Sheets("SLA_Report").Visible = True Or Sheets("Calls_Info").Visible = True Then
            Sheets(Array("MyReports", "My_Links", "SLA_Report", "Calls_Info")).Select
    ActiveWindow.SelectedSheets.Visible = False
                
    End If

Application.ScreenUpdating = True
End Sub

Thanks,
TAMATAM

How to Delete Specific or Unwanted Sheets from a Workbook with Excel Macro

Macro To Delete Specific or Unwanted Sheets from a Workbook 
'Suppose in your workbook you have some sheets  as shown below :
"MyReports","My_Links", "Sheet1","SLA_Report","Sheet2", "Calls_Info", "Files_Info", "Sheet3","Control_Panel"

Among these sheets if you want to Keep only "MyReports","My_Links", "SLA_Report", "Calls_Info", "Files_Info", "Control_Panel" Sheets and delete rest all sheets.

To do this task we can use the following Macro with Case Statement.

Public Sub Delte_UnWantedSheets()

    Dim WS_Name As String
    Dim WB_Main As Object
    Dim WS As Worksheet
    
    Set WB_Main = ThisWorkbook

  For Each WS In WB_Main.Sheets
        WS_Name = WS.Name
        
   Select Case WS_Name
        
        Case "MyReports" 
        Case "My_Links"
        Case "SLA_Report"
        Case "Calls_Info"
        Case "Files_Info"
        Case "ControlPanel"
        
   Case Else 'Other than any sheet delete

            Application.DisplayAlerts = False
            WB_Main.Sheets(WS_Name).Delete 
            Application.DisplayAlerts = True

    End Select
        
 Next

 End Sub

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

If you want to Delete the specific sheets from the above example , we can use the following Macro.

Method - II :
 Public Sub Delete_SpecificSheets()

    Dim WS_Name As String
    Dim WB_Main As Object
    Dim WS As Worksheet
    
    Set WB_Main = ThisWorkbook
 For Each WS In WB_Main.Sheets(Array("Sheet1", "Sheet2", "Sheet3"))

    Application.DisplayAlerts = False
            WS.Delete
    Application.DisplayAlerts = True
   
 Next

 End Sub

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

How to Call this Macro in Workbook Event : Workbook_Open()
Be Cautious that the Event will occur on Opening of the Workbook, You may lost your data sheets if wrongly use this event.

Private Sub Workbook_Open()
Call Delte_UnWantedSheets
End Sub

Thanks, TAMATAM

How to Sort Pivot Table Row Labels, Column Field Labels and Data Values with Excel VBA Macro

Macro To Sort Pivot Table Row Labels, Column Field Labels and Data Values
Sub Sort_Pivot_Row_Column_Data()    
Range("G3").Select    
'To Sort Descending the Column Labels
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Sales_Period").AutoSort _
        xlDescending, "Sales_Period"
        
'To Sort Descending the Row Labels
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Prod_Id").AutoSort _
        xlDescending, "Prod_Id"
        
'To Sort Descending the Data Values based on particular Column Label(3)
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Prod_Id").AutoSort _
        xlDescending, "Sum of Sales", ActiveSheet.PivotTables("PivotTable1"). _
        PivotColumnAxis.PivotLines(3), 1     
End Sub

Example :

Sample Pivot Data Table

To Sort Descending the Row Labels

    ActiveSheet.PivotTables("PivotTable1").PivotFields("Prod_Id").AutoSort _
        xlDescending, "Prod_Id"

Output :

To Sort Descending the Column Labels

    ActiveSheet.PivotTables("PivotTable1").PivotFields("Sales_Period").AutoSort _
        xlDescending, "Sales_Period"

Output :

To Sort Descending Data Values based on particular Column Label(3) ="Q3-2014"

    ActiveSheet.PivotTables("PivotTable1").PivotFields("Prod_Id").AutoSort _
        xlDescending, "Sum of Sales", ActiveSheet.PivotTables("PivotTable1"). _
        PivotColumnAxis.PivotLines(3), 1

Output :

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

How to change Pivot Chart Slicer, Filter Item dynamically and and Print the Chart of each Slicer Item on Power Point Slides using Macro

Excel VBA Macro to change Pivot Chart Slicer, Filter Item dynamically and Print the Chart of each Slicer Item on Power Point Slides
Let us Suppose there is Pivot Chart with Slicer in Active Sheet as Shown below :

Now if we want to apply the Filter for each Slicer Item of Sales_Period and Generate the Charts for each Period , which means Chart for Q1-2014,Q2-2014...Q4-2014.
We can do using the following Macro.

Sub Create_PPT_Chart_Foreach_SlicerItem()
 Dim New_PowerPoint As Object
 Dim PPT_Present As PowerPoint.Presentation
 Dim ActiveSlide As PowerPoint.Slide
 Dim SL_Item As SlicerItem
 Dim WB As Object

 SavePath = ThisWorkbook.Path
 Present_Name = ThisWorkbook.Name
 Set WB = ActiveWorkbook

 Chart_Name = "Quarterly_Sales" '--This is the Chart Name
 Slicer_Name = "Slicer_Sales_Period1" '--This is the Slicer Name
    
On Error Resume Next
   'Set New_PowerPoint = GetObject(, "PowerPoint.Application")
    Set New_PowerPoint = CreateObject("PowerPoint.Application")
On Error GoTo 0
     
If New_PowerPoint Is Nothing Then
        Set New_PowerPoint = New PowerPoint.Application
End If

If New_PowerPoint.Presentations.Count = 0 Then
    'Set PPT_Present = New_PowerPoint.Presentations.Add
    Set PPT_Present = New_PowerPoint.Presentations.Open("C:\Users\Tamatam\Desktop\Temp\Sales_Deck.pptx")
End If
     
New_PowerPoint.Visible = True
ActiveSheet.ChartObjects(Chart_Name).Activate
    
X = WB.SlicerCaches(Slicer_Name).SlicerItems.Count
WB.SlicerCaches(Slicer_Name).ClearManualFilter

'Loop through Active Chart Slicer Filter Items applying Filter to Generate Chart and Paste into the PowerPoint Slide

For Y = 1 To X
       New_PowerPoint.ActivePresentation.Slides.Add
       New_PowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutText
       New_PowerPoint.ActiveWindow.View.GotoSlide                                                                      New_PowerPoint.ActivePresentation.Slides.Count
Set ActiveSlide = New_PowerPoint.ActivePresentation.Slides(New_PowerPoint.ActivePresentation.Slides.Count)

'Deleting Title and Body Text boxes from PPT Slide if Not require.
    ActiveSlide.Shapes(1).Delete 'Deleting shape(1)from PPTslide
    ActiveSlide.Shapes(1).Delete 'Deleting shape(2) from PPTslide
    
 Quarter = WB.SlicerCaches(Slicer_Name).SlicerItems(Y).Name
 'Looping through each Slicer Item and Checking condition to Select or Deselect
For Each SL_Item In WB.SlicerCaches(Slicer_Name).SlicerItems
    If SL_Item.Name = Quarter Then
        SL_Item.Selected = True
    Else
        SL_Item.Selected = False
    End If
 Next SL_Item

 ActiveSheet.ChartObjects(Chart_Name).Activate
    ActiveChart.ChartArea.Copy

    ActiveSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select

'<< Pasting with Source Formatting >>
             PPT_Slide.Select
             PPT_Slide.Application.CommandBars.ExecuteMso ("PasteSourceFormatting")

'Adjusting the positioning of the Chart on Powerpoint Slide
    New_PowerPoint.ActiveWindow.Selection.ShapeRange.LockAspectRatio = msoFalse
    New_PowerPoint.ActiveWindow.Selection.ShapeRange.Width = 630
    New_PowerPoint.ActiveWindow.Selection.ShapeRange.Height = 450
    New_PowerPoint.ActiveWindow.Selection.ShapeRange.Left = 50
    New_PowerPoint.ActiveWindow.Selection.ShapeRange.Top = 50    
WB.SlicerCaches(Slicer_Name).ClearManualFilter
Next Y
    
'Saving the Presentation
PPT_Present.SaveAs SavePath & "\" & Present_Name & ".pptx"

PPT_Present.Close
Set PPT_Present = Nothing
Set ActiveSlide = Nothing
'Closing the Powepoint Application Window
New_PowerPoint.Quit
Set New_PowerPoint = Nothing

MsgBox "Chart for each Period is Printed on PowerPoint Slides", vbOKOnly, "PPTs Generated Successfully"
End Sub

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

Thanks, TAMATAM ; Business Intelligence & Analytics Professional

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

How to Generate PowerPoint Slides for each Chart in Active Sheet with Excel VBA Macro

Excel VBA Macro to Generate PowerPoint Slides for each Chart in Active Sheet
Suppose In a Workbook Sheet if we have some Charts.
Now if you want the Generate the Power Point Slides for each Chart , and we can use the following Macro.
This Macro will generate the Slide for each Chart in Active Sheet and Save the Presentation in active Workbook Path with Workbook Name.
------------------------------------------------------------------------------
Sub Create_PPT_Charts_Activesheet()
 Dim New_PowerPoint As Object
 Dim PPT_Present As Powerpoint.Presentation
 Dim ActiveSlide As Powerpoint.Slide
 Dim Cht As Excel.ChartObject
     
 SavePath = ThisWorkbook.Path
 Present_Name = ThisWorkbook.Name
    
On Error Resume Next
   'Set New_PowerPoint = GetObject(, "PowerPoint.Application")
Set New_PowerPoint = CreateObject("PowerPoint.Application")

On Error GoTo 0     
If New_PowerPoint Is Nothing Then
        Set New_PowerPoint = New Powerpoint.Application
End If

If New_PowerPoint.Presentations.Count = 0 Then
        Set PPT_Present = New_PowerPoint.Presentations.Add
       'Set PPT_Present = New_PowerPoint.Presentations.Open("C:\Users\Tamatam\Downloads\Temp.pptx")
End If
     
New_PowerPoint.Visible = True
'Loop through each chart in the Excel worksheet and paste them into the PowerPoint
For Each Cht In ActiveSheet.ChartObjects        
New_PowerPoint.ActivePresentation.Slides.Add 
New_PowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutText
New_PowerPoint.ActiveWindow.View.GotoSlide 
New_PowerPoint.ActivePresentation.Slides.Count

Set ActiveSlide = New_PowerPoint.ActivePresentation.Slides                                                                                            (New_PowerPoint.ActivePresentation.Slides.Count)
'Deleting Title and Body Text boxes from PPT Slide if Not require.
 ActiveSlide.Shapes(1).Delete 'Deleting shape(1)from PPTslide
 ActiveSlide.Shapes(1).Delete 'Deleting shape(2) from PPTslide        
'Copy the chart and paste it into the PowerPoint as a Picture
 Cht.Select
 ActiveChart.ChartArea.Copy
 ActiveSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select

'<< Pasting with Source Formatting >>
             PPT_Slide.Select
             PPT_Slide.Application.CommandBars.ExecuteMso ("PasteSourceFormatting")

'Adjusting the positioning of the Chart on Powerpoint Slide
New_PowerPoint.ActiveWindow.Selection.ShapeRange.LockAspectRatio = msoFalse
New_PowerPoint.ActiveWindow.Selection.ShapeRange.Width = 620
New_PowerPoint.ActiveWindow.Selection.ShapeRange.Height = 400
    
New_PowerPoint.ActiveWindow.Selection.ShapeRange.Left = 55
New_PowerPoint.ActiveWindow.Selection.ShapeRange.Top = 65
Next Cht

PPT_Present.SaveAs SavePath & "\" & Present_Name & ".pptx"

PPT_Present.Close
Set PPT_Present = Nothing
Set ActiveSlide = Nothing
'Closing the Powepoint Application Window
New_PowerPoint.Quit
Set New_PowerPoint = Nothing
    
MsgBox " Each Chart from Active is Printed on PowerPoint Slides", vbOKOnly, "PPTs Generated Successfully"
End Sub

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

Thanks, TAMATAM ; Business Intelligence & Analytics Professional

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

How to Generate Power Point Presentation Slides for each Chart in Active Sheet with Excel VBA Macro

Excel VBA Macro to Generate Power Point Presentation Slides for each Chart in Active Sheet.
Suppose In a Workbook Sheet if we have some charts with Titles and Notes.

Now if you want the Generate the Power Point Slides for each Chart with Titles and Notes , and we can use the following Macro.
This Macro will generate the Slide for each Chart in Active Sheet and Save the Presentation in active Workbook Path with Workbook Name.
------------------------------------------------------------------
Sub Create_PPT_Charts_with_Titles_Comments_Activesheet()
 Dim New_PowerPoint As Object
 Dim PPT_Present As Powerpoint.Presentation
 Dim ActiveSlide As Powerpoint.Slide
 Dim Cht As Excel.ChartObject
     
 SavePath = ThisWorkbook.Path
 Present_Name = ThisWorkbook.Name
    
On Error Resume Next
   'Set New_PowerPoint = GetObject(, "PowerPoint.Application")
    Set New_PowerPoint = CreateObject("PowerPoint.Application")
On Error GoTo 0
     
If New_PowerPoint Is Nothing Then
        Set New_PowerPoint = New Powerpoint.Application
End If

If New_PowerPoint.Presentations.Count = 0 Then
        Set PPT_Present = New_PowerPoint.Presentations.Add
       'Set PPT_Present = New_PowerPoint.Presentations.Open                                                                                      ("C:\Users\Tamatam\Downloads\Temp.pptx")
End If     
    New_PowerPoint.Visible = True    
'Loop through each chart in the Excel worksheet and paste them into the PowerPoint
For Each Cht In ActiveSheet.ChartObjects
        
New_PowerPoint.ActivePresentation.Slides.Add       New_PowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutText
New_PowerPoint.ActiveWindow.View.GotoSlide New_PowerPoint.ActivePresentation.Slides.Count
Set ActiveSlide = New_PowerPoint.ActivePresentation.Slides                                                                            (New_PowerPoint.ActivePresentation.Slides.Count)

'Set the Title of the slide the same as the Title of the Chart
ActiveSlide.Shapes(1).TextFrame.TextRange.Text = Cht.Chart.ChartTitle.Text
   'ActiveSlide.Shapes(1).TextFrame.TextRange.Font.Size = 30
   
'Add the Comments in the Text box of the slide based on the Region Chart
ActiveSlide.Shapes(2).Width = 180
ActiveSlide.Shapes(2).Left = 490
    
'If the Chart is the "US" Chart, then enter the appropriate Notes
If InStr(ActiveSlide.Shapes(1).TextFrame.TextRange.Text, "US") Then
        ActiveSlide.Shapes(2).TextFrame.TextRange.Text = Range("J7").Value & vbNewLine
        ActiveSlide.Shapes(2).TextFrame.TextRange.InsertAfter (Range("J8").Value & vbNewLine)
        ActiveSlide.Shapes(2).TextFrame.TextRange.InsertAfter (Range("J9").Value & vbNewLine)
        ActiveSlide.Shapes(2).TextFrame.TextRange.Font.Size = 18
'Else if the Chart is the "UK" Chart, then enter the appropriate Notes
ElseIf InStr(ActiveSlide.Shapes(1).TextFrame.TextRange.Text, "UK") Then
        ActiveSlide.Shapes(2).TextFrame.TextRange.Text = Range("J27").Value & vbNewLine
        ActiveSlide.Shapes(2).TextFrame.TextRange.InsertAfter (Range("J28").Value & vbNewLine)
        ActiveSlide.Shapes(2).TextFrame.TextRange.InsertAfter (Range("J29").Value & vbNewLine)
        ActiveSlide.Shapes(2).TextFrame.TextRange.Font.Size = 18
End If
    
'Deleting Title and Body Text boxes from PPT Slide if Not require.
   'ActiveSlide.Shapes(1).Delete 'Deleting shape(1)from PPTslide
   'ActiveSlide.Shapes(1).Delete 'Deleting shape(2) from PPTslide
        
'Copy the chart and paste it into the PowerPoint as a Picture on Slide
    Cht.Select
    ActiveChart.ChartArea.Copy
    ActiveSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select
    
'<< Pasting with Source Formatting >>
             PPT_Slide.Select
             PPT_Slide.Application.CommandBars.ExecuteMso ("PasteSourceFormatting")

'Adjusting the positioning of the Chart on Powerpoint Slide
 New_PowerPoint.ActiveWindow.Selection.ShapeRange.LockAspectRatio = msoFalse
 New_PowerPoint.ActiveWindow.Selection.ShapeRange.Width = 455
 New_PowerPoint.ActiveWindow.Selection.ShapeRange.Height = 360
    
 New_PowerPoint.ActiveWindow.Selection.ShapeRange.Left = 35
 New_PowerPoint.ActiveWindow.Selection.ShapeRange.Top = 125
    
Next Cht

'Saving the Presentation
PPT_Present.SaveAs SavePath & "\" & Present_Name & ".pptx"

PPT_Present.Close
Set PPT_Present = Nothing
Set ActiveSlide = Nothing
'Closing the Powepoint Application Window
New_PowerPoint.Quit
Set New_PowerPoint = Nothing

MsgBox " Each Chart from Active is Printed on PowerPoint Slides", vbOKOnly, "PPTs Generated Successfully"
End Sub

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

Thanks, TAMATAM ; Business Intelligence & Analytics Professional

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

How to Delete all Records from a MS Access Table with Excel VBA Macro

Excel Macro to Delete all Records from a MS Access Table

Sub Delete_All_Records_Table()
Dim Str_MyPath As String, Str_DBName As String, Str_DB As String, Str_SQL As String
Dim ADO_RecSet As New ADODB.Recordset
Dim Conn_DB As New ADODB.Connection
Dim Str_SQL 
Dim DB_Table

Str_DBName = "Test_DB.accdb"
Str_MyPath = "C:\Users\Tamatam\Desktop\Temp"
Str_DB = Str_MyPath & "\" & Str_DBName

Conn_DB.Open ConnectionString:="Provider = Microsoft.ACE.OLEDB.12.0; data source=" & Str_DB
Set ADO_RecSet = New ADODB.Recordset
DB_Table = "MyTable"

Str_SQL = "Delete*from MyTable"  'Here you can Pass any SQL Query to Perform

ADO_RecSet.Open Source:=Str_SQL, ActiveConnection:=Conn_DB, CursorType:=adOpenDynamic, LockType:=adLockOptimistic

Conn_DB.Close
Set ADO_RecSet = Nothing
Set Conn_DB = Nothing
MsgBox "All Records from Table has been Deleted SuccessFully", vbOKOnly, "Job Done"

End Sub

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

How to Set the Pivot Table Grand Totals on for Rows and Columns in Excel

Excel VBA Macro to Set the Pivot Table Grand Totals on Rows and Columns
Sub PVT_GrandTotals_OnRows_Columns ()
Dim Pivot_Name as String
'Select any in Cell the Pivot Table Area
ActiveSheet.Range("I4").Select 
'Storing Pivot Table Name in a Variable
Pivot_Name = Selection.PivotTable.Name

    With ActiveSheet.PivotTables(Pivot_Name)
        .ColumnGrand = True
        .RowGrand = True
    End With

End Sub

Eg :
Pivot Table without Grand Totals :

Pivot Table with Grand Totals on Rows and Columns:

Manually we can Set the Pivot Table Grand Totals on Rows and Columns by selecting "PivotTable Tools>Design>Grand Totals>On for Rows and Columns" as shown below.

By doing this we will get "Grand Total" for Columns at Last Row and for Rows at Last Column of the Pivot Table.

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

Excel VBA Macro to Import or Copy All Data with SQL Query from Specific Fields of a MS Access Table into Excel Sheet

Excel VBA Macro to Import or Copy All Data with SQL Query from Specific Fields of a MS Access Table into Excel Sheet
Sub Import_SpecificData_From_Access_Table_Fields_To_Excel()
Dim Str_MyPath As String, Str_DBName As String, Str_DB As String, Str_SQL As String
Dim K As Long, N As Long, Fields_Count As Long
Dim Rng As Range

Dim ADO_RecSet As New ADODB.Recordset
Dim Conn_DB As New ADODB.Connection

Str_DBName = "Sales_DB.accdb"
Str_MyPath = "C:\Users\Tamatam\Desktop\Temp"
Str_DB = Str_MyPath & "\" & Str_DBName

'Connect to a data source:
'For Pre - MS Access 2007, .mdb files (viz. MS Access 97 up to MS Access 2003), use the Jet provider:"Microsoft.Jet.OLEDB.4.0".
'For Access 2007 (.accdb database) use the ACE Provider: "Microsoft.ACE.OLEDB.12.0".
'The ACE Provider can be used for both the Access .mdb & .accdb files.
Conn_DB.Open ConnectionString:="Provider = Microsoft.ACE.OLEDB.12.0; data source=" & Str_DB

Dim WS As Worksheet
Set WS = ActiveWorkbook.ActiveSheet

Set ADO_RecSet = New ADODB.Recordset
DB_Table = "Products"

'COPY All RECORDS FROM Selected FIELDS USING CopyFromRecordset:
'Open Recordset/Table:
Str_SQL= "SELECT Product_ID, Prod_Name,Product_Group,Sales_Date FROM Products WHERE Product_Group='Bikes'"

ADO_RecSet.Open Source:=Str_SQL, ActiveConnection:=Conn_DB, CursorType:=adOpenDynamic, LockType:=adLockOptimistic

Set Rng = WS.Range("A1")
Fields_Count = ADO_RecSet.Fields.Count

'Copy Column Names of Table into First Row of the Worksheet:
For K = 0 To Fields_Count - 1
Rng.Offset(0, K).Value = ADO_RecSet.Fields(K).Name
Next K

'Copy All Records values to the Worksheet starting from Second Row :
Rng.Offset(1, 0).CopyFromRecordset ADO_RecSet

'To Copy only 8 Rows and 4 Columns of the Recordset to Excel Worksheet:
'Rng.Offset(1, 0).CopyFromRecordset Data:=ADO_RecSet, MaxRoWS:=8, MaxColumns:=4

'Select a Column Range:
Range(WS.Columns(1), WS.Columns(Fields_Count)).AutoFit
ADO_RecSet.Close

'Close the objects
Conn_DB.Close
'Destroy the Variables
Set ADO_RecSet = Nothing
Set Conn_DB = Nothing

MsgBox "Table has been Copied SuccessFully", vbOKOnly, "Job Done"
End Sub

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

How to Import or Copy All Data from a MS Access Database Table in to Excel Sheet

Excel VBA Macro to Import or Copy All Data from a MS Access Database Table into Excel Sheet
Sub Import_AllData_From_AccDB_Table_To_Excel()
'Using ADO to Import data from an Access Database Table to an Excel worksheet (your host application).

'To use ADO in your VBA project, you must add a reference to the ADO Object Library in Excel(your host application) by clicking Tools-References in VBE,and then choose an appropriate version of Microsoft ActiveX Data Objects x.x Library from the list.

Dim Str_MyPath As String, Str_DBName As String, Str_DB As String, Str_SQL As String
Dim K As Long, N As Long, Fields_Count As Long
Dim Rng As Range

Dim ADO_RecSet As New ADODB.Recordset
Dim Conn_DB As New ADODB.Connection

Str_DBName = "Sales_DB.accdb"
Str_MyPath = "C:\Users\Tamatam\Desktop\Temp"
Str_DB = Str_MyPath & "\" & Str_DBName

'Connect to a data source:
'For Pre - MS Access 2007, .mdb files (viz. MS Access 97 up to MS Access 2003), use the Jet provider:"Microsoft.Jet.OLEDB.4.0".
'For Access 2007 (.accdb database) use the ACE Provider: "Microsoft.ACE.OLEDB.12.0".
'The ACE Provider can be used for both the Access .mdb & .accdb files.

Conn_DB.Open ConnectionString:="Provider = Microsoft.ACE.OLEDB.12.0; data source=" & Str_DB

Dim WS As Worksheet
Set WS = ActiveWorkbook.ActiveSheet

Set ADO_RecSet = New ADODB.Recordset
DB_Table = "Products"

'COPY RECORDS FROM ALL FIELDS USING CopyFromRecordset:
'Open Recordset/Table:

ADO_RecSet.Open Source:=DB_Table, ActiveConnection:=Conn_DB, CursorType:=adOpenStatic, LockType:=adLockOptimistic

Set Rng = WS.Range("A1")
Fields_Count = ADO_RecSet.Fields.Count

'Copy Column Names of Table into First Row of the Worksheet:
For K = 0 To Fields_Count - 1
Rng.Offset(0, K).Value = ADO_RecSet.Fields(K).Name
Next K

'Copy All Records values to the Worksheet starting from Second Row :
Rng.Offset(1, 0).CopyFromRecordset ADO_RecSet

'To Copy only 8 Rows and 4 Columns of the Recordset to Excel Worksheet:
'Rng.Offset(1, 0).CopyFromRecordset Data:=ADO_RecSet, MaxRoWS:=8, MaxColumns:=4

'Select a Column Range:
Range(WS.Columns(1), WS.Columns(Fields_Count)).AutoFit
ADO_RecSet.Close

'Close the objects
Conn_DB.Close

'Destroy the Variables
Set ADO_RecSet = Nothing
Set Conn_DB = Nothing
MsgBox "Table has been Copied SuccessFully", vbOKOnly, "Job Done"

End Sub

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

How to Delete a Specific File from a Folder using Excel VBA Macro

Excel VBA Macro to Delete a Specific File from a Folder
Sub Delete_File()
Dim FSO as Object
Dim sFile As String

'Source File Location
sFile = "C:\Users\Tamatam\Desktop\Temp\Test.jpg" 'You can change this Loaction

'Set Object
Set FSO = CreateObject("Scripting.FileSystemObject")

'Check File Exists or Not
If FSO.FileExists(sFile) Then

'If file exists, It will delete the file from source location
FSO.DeleteFile sFile, True
MsgBox "Deleted The File Successfully", vbInformation, "Done!"
Else

'If file does not exists, It will display following message
MsgBox "Specified File Not Found", vbInformation, "Not Found!"
End If
End Sub

Thanks,TAMATAM