Pasting data in the reverse order

You might have come across with situation where you wanted to paste your data in reverse order. In the example below we want the numbers in Data column in reverse order. This can be done using excel formula.

Data	Reverse Data
1	5
2	4
3	3
4	2
5	1

Following formula can be used:

=INDEX($A$2:$A$6,ROWS(A2:A$6))

Copy data from Excel to Notepad

VBA Code to copy data from Excel to Notepad:


Sub copyPastedata_in_Notepad()
With Application
Selection.Copy
Shell "notepad.exe", 3
SendKeys "^v"
VBA.AppActivate .Caption
.CutCopyMode = False
End With

End Sub

VBA Code to Collapse and Expand columns

VBA Code to Collapse and Expand columns based on the given criteria:


Sub Collapse_Expand()
Dim w As Worksheet
Dim pt As PivotTable
Dim FinYear As String
Dim QTD As String

FinYear = "FY" & Right(Date, 2)
QTD = "Q3                             "
        
        For Each w In ThisWorkbook.Worksheets
            If ActiveSheet.Name = "Sheet1" Or ActiveSheet.Name = "Sheet2" Then
                ActiveSheet.PivotTables("PivotTable1").PivotFields("Rev_Cost").ShowDetail = False
                ActiveSheet.PivotTables("PivotTable1").PivotFields("Quarter").ShowDetail = False
                ActiveSheet.PivotTables("PivotTable1").PivotFields("Year").ShowDetail = False
                
                ActiveSheet.PivotTables("PivotTable1").PivotFields("Rev_Cost").PivotItems("Rev").ShowDetail = True
                ActiveSheet.PivotTables("PivotTable1").PivotFields("Rev_Cost").PivotItems("Cost").ShowDetail = True
                ActiveSheet.PivotTables("PivotTable1").PivotFields("Year").PivotItems(FinYear).ShowDetail = True
                ActiveSheet.PivotTables("PivotTable1").PivotFields("Quarter").PivotItems(QTD).ShowDetail = True
            End If
                On Error Resume Next
                Sheets(ActiveSheet.Index + 1).Activate
                If Err.Number <> 0 Then Sheets(1).Activate
        Next
End Sub

Zip Files using VBA

VBA Code to zip files:

Private Sub ZipFile_FX(ZipFileName As String, fileToBeZipped As String)
Const ZIPEXELOCATION = "c:\program files\winzip\winzip32.exe"
Shell ZIPEXELOCATION & " -a " & Chr(34) & ZipFileName & Chr(34) & _
" " & Chr(34) & fileToBeZipped & Chr(34), vbNormalFocus
End Sub

sub zips()
Call ZipFile_FX("c:\b.zip", "c:\b.xls")
end sub

Zip files in a folder

VBA code to zip files in any folder:


Sub Zip_File_Or_Files()
    Dim FSO As New FileSystemObject
    Dim Fld As Folder, Fle As File
    Dim strDate As String, DefPath As String
    Dim oApp As Object
    Dim FileNameZip

    Sheets("Sheet1").Select
    LR = Range("B2").End(xlDown).Row
    For LV = 3 To LR
        DefPath = Range("B3").Value
        FileNameZip = DefPath & "\TestFile" & ".zip"
        NewZip (FileNameZip)
        Set Fld = FSO.GetFolder(DefPath)
        For Each Fle In Fld.Files
            If InStr(1, Fle.Type, "Excel") <> 0 Then
                Set oApp = CreateObject("Shell.Application")
                oApp.Namespace(FileNameZip).CopyHere Fle.Path
                 'Keep script waiting until Compressing is done
                On Error Resume Next
                Application.Wait (Now + TimeValue("0:00:01"))
                On Error GoTo 0
            End If
        Next Fle
    Next LV
End Sub

Sub NewZip(sPath) 'Create empty Zip File
    If Len(Dir(sPath)) > 0 Then Kill sPath
    Open sPath For Output As #1
    Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
    Close #1
End Sub

List of all Worksheet Names

VBA macro to list down all worksheet names in a workbook:

Sub SheetNames() 

    Columns(1).Insert 

    For i = 1 To Sheets.Count 

        Cells(i, 1) = Sheets(i).Name 

    Next i 

End Sub 

Collapsing and expanding of columns

We work on Pivot Tables where we collapse and expand columns. You might come across with situation where you have two pivot tables. What you want to do is when you expand one same column in other pivot table should also expand.

Below code can be used to do that. Put the following code in a module:


Sub LinkPivotTables_ByFieldItemName_ToShowDetail(pt As PivotTable)  'takes as argument - pt As PivotTable

Dim wkb As Workbook
Set wkb = ThisWorkbook

Dim wks As Worksheet
Set wks = wkb.Sheets(2) 'Mention the sheet name where Pivots are stored

Dim PivotTableIndex As Integer
Dim PivotItemIndex As Integer
Dim PivotFieldIndex As String
Dim BoolValue As Boolean
Dim ItemName As String

Application.ScreenUpdating = False
Application.EnableEvents = False

PivotFieldIndex = "VP" 'Mention column name which you want to collapse/expand

On Error Resume Next


        For PivotItemsIndex = 1 To pt.PivotFields(PivotFieldIndex).PivotItems.Count

        BoolValue = pt.PivotFields(PivotFieldIndex).PivotItems(PivotItemsIndex).ShowDetail
        ItemName = pt.PivotFields(PivotFieldIndex).PivotItems(PivotItemsIndex).Name

            For PivotTableIndex = 1 To wks.PivotTables.Count

                ' This If statement will dramatically increase efficiency - because it takes a long long time to set the value but it doesn't take long to check it.
                If wks.PivotTables(PivotTableIndex).PivotFields(PivotFieldIndex).PivotItems(PivotItemsIndex).ShowDetail <> BoolValue Then
                    wks.PivotTables(PivotTableIndex).PivotFields(PivotFieldIndex).PivotItems(PivotItemsIndex).ShowDetail = BoolValue
                End If

            Next PivotTableIndex

        Next PivotItemsIndex

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

Put the below code in the active sheet where the pivots are placed:


Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)

Call LinkPivotTables_ByFieldItemName_ToShowDetail(Target)

Call LinkPivotTables_ByFieldItemName_ToShowDetail_Executive_Manager(Target)

Call LinkPivotTables_ByFieldItemName_ToShowDetail_Regional_Manager(Target)

End Sub