Advanced Excel Tips-Macros/VBA

Tutorial On Power Platform & VBA
https://lgtechtipstricks.blogspot.com/

Q : Move Outlook Mail in Specific Folder
Dim OlApp As Object
Dim MailItem As Object
Dim NS As Object
Set OlApp = CreateObject("Outlook.Application")
Set MailItem=OlApp.CreateItem(0)
Set NS = GetNamespace("MAPI")
Set OlDraft=NS.GetDefaultFolder("Draft")
With MailItemDisplayTo ="[email protected]"CC =" "Subject ="Move Emails"
MailItem.Move OlDraft
End With
Set OlApp = Nothing
Set MailItem = Nothing

Q : Convert Range into an Image
Ans :
Sub PasteAsPicture()
Application.CutCopyMode = False
Sheet1.Range("A1:K100").Copy
ActiveSheet.Pictures.Paste.Select
End Sub

Paste selected range as an image. You just have to select the range and once you run this code it will automatically insert a picture for that range.

Q : Refresh All Pivot Tables
Ans :
Sub RefreshAllPivots()
Dim pt As PivotTable
For Each pt In ActiveWorkbook.PivotTables pt.RefreshTable
Next pt
End Sub

Q : Attach Active Workbook in an Email
Ans :
Sub Send_Mail()
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail To = "[email protected]" Subject = "Lalasaheb Gaikwad Report" Body ="" & "Hi Team," & "" & "Please find attached Report." & ""Attachments.Add ActiveWorkbook.FullName Display
'.Send
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Use this macro code to quickly send your active workbook in an e-mail. You can change the subject, email, and body text in code and if you want to send this mail directly, use ".Send" instead of ".Display".

Q : Close all Workbooks at Once
Ans :
Sub CloseAllWorkbooks()
Dim wbs As Workbook
For Each wbs In Workbooks
wbs.Close SaveChanges:=True
Next wb
End Sub

Use this macro code to close all open workbooks.
This macro code will first check all the workbooks one by one and close them.
If any of the worksheets is not saved, you'll get a message to save it.

Q : Disable Page Breaks
Ans :
Sub DisablePageBreaks()
Dim wb As Workbook
Dim wks As Worksheet
Application.ScreenUpdating = False
For Each wb In Application.Workbooks
For Each S*t In wb.Worksheets
S*t.DisplayPageBreaks = False
Next S*t
Next wb
Application.ScreenUpdating = True
End Sub

Q: Save Each Worksheet as a Single PDF
Ans :
Sub SaveWorkshetAsPDF()

Dim ws As Worksheet

For Each ws In Worksheets ws.ExportAsFixedFormat xlTypePDF, "D:\LG\" & ws.Name & ".pdf"
Next ws
End Sub

This code will simply save all the worksheets in a separate PDF file. You just need to change the folder name from the code.

Q : Unhide all Rows and Columns
Ans :
Sub UnhideRowsColumns()
Columns.EntireColumn.Hidden = False
Rows.EntireRow.Hidden = False
End Sub

Q : Delete all Blank Worksheets
Ans :
Sub deleteBlankWorksheets()
Dim Ws As Worksheet
On Error Resume Next
Application.ScreenUpdating= False
Application.DisplayAlerts= False
For Each Ws In Application.Worksheets
If Application.WorksheetFunction.CountA(Ws.UsedRange) = 0 Then
Ws.Delete
End If
Next
Application.ScreenUpdating= True Application.DisplayAlerts= True
End Sub

Q : Resize All Charts in a Worksheet
Ans :
Sub Resize_Charts()
Dim i As Integer
For i = 1 To ActiveSheet.ChartObjects.Count With ActiveSheet.ChartObjects(i) Width = 300 Height = 200
End With
Next i
End Sub