Toggle between multiple excels sheets using Macro

Ok... let me explain you how to toggle between multiple screens in Excel using Macros.

Dim WB,WB1 as workbook
Dim WS,WS1 as worksheet

Set WB=Activeworkbook
Set WS=Activeworkbook.sheeets("Sheet1")

Workbooks.open("New excel wb name.xls")

Set WB1=Activeworkbook
Set WS1=Activeworkbook.sheets("Sheet2")

Now you are working with the second excel wb, and if you wish to toggle to the first workbook

use the below code

WB.Activate
WS.select

and if you require to toggle back to the 2nd workbook....

WB1.Activate
WS1.select

.... Happy Coding :)

Sum the visible cell values from the filtered range

Function Sum_Visible_Cells(ByRef Cells_To_Sum As String)

Application.Volatile

Range(Cells_To_Sum).SpecialCells(xlCellTypeVisible).Select
Sum_Visible_Cells = WorksheetFunction.Sum(Selection)

End Function

Realign sheets as per the current months calendar

Sub Movesheets_Vijay_Anand()
' This is a self built logic designed by
' B.Vijay Anand -
' Please appreciate the logic design and the coding
' but do not try to take ownership of this prg and logic which you haven;t done
' you are free to use this program
'Sheets required to run this code
' Sheet1, 1,2,3,4,...31 and WTD1.... WTD6,MTD
On Error Resume Next
Set wb = ActiveWorkbook
Sheets("WTD1").Move after:=Sheets("31")
Sheets("WTD2").Move after:=Sheets("31")
Sheets("WTD3").Move after:=Sheets("31")
Sheets("WTD4").Move after:=Sheets("31")
Sheets("WTD5").Move after:=Sheets("31")
Sheets("WTD6").Move after:=Sheets("31")
Sheets("Sheet1").Select
Cells.Select
Selection.ClearContents
i = 1
Cells(1, 1).Resize(31, 1).ClearContents
Range("A1").Value = Month(Now) & "/01/" & Year(Now)
Range("A1").NumberFormat = "ddd dd/mm/yyyy"
Range("A1").AutoFill Destination:=Range("A1:A40"), Type:=xlFillDefault
For i1 = 40 To 1 Step -1
If Year(Cells(i1, 1).Value) > Year(Now) Then
Rows(i1).EntireRow.Delete
ElseIf Month(Cells(i1, 1).Value) > Month(Now) Then
Rows(i1).EntireRow.Delete
End If
Next i1
For i1 = 1 To 40 Step 1
If Weekday(Cells(i1, 1).Value, vbMonday) = 7 Then
Rows(i1 + 1).EntireRow.Insert
Cells(i1 + 1, 1).Value = "WTD" & i
i = i + 1
i1 = i1 + 1
End If
Next i1
Cells(1, 1).Select
Selection.End(xlDown).Select
Selection.End(xlDown + 1).Select
xy = ActiveCell.Row
Cells(xy + 1, 1).Value = "WTD" & i

For ii1 = 1 To 40 Step 1

If Sheets("Sheet1").Cells(ii1, 1).Value = "WTD1" Then
Sheets(ii1).Select
Sheets("WTD1").Move after:=ActiveSheet
ElseIf Sheets("Sheet1").Cells(ii1, 1).Value = "WTD2" Then
Sheets(ii1).Select
Sheets("WTD2").Move after:=ActiveSheet

ElseIf Sheets("Sheet1").Cells(ii1, 1).Value = "WTD3" Then
Sheets(ii1).Select
Sheets("WTD3").Move after:=ActiveSheet

ElseIf Sheets("Sheet1").Cells(ii1, 1).Value = "WTD4" Then
Sheets(ii1).Select
Sheets("WTD4").Move after:=ActiveSheet

ElseIf Sheets("Sheet1").Cells(ii1, 1).Value = "WTD5" Then
Sheets(ii1).Select
Sheets("WTD5").Move after:=ActiveSheet

ElseIf Sheets("Sheet1").Cells(ii1, 1).Value = "WTD6" Then
Sheets(ii1).Select
Sheets("WTD6").Move after:=ActiveSheet

End If
Next ii1
Sheets("Sheet1").Select

MsgBox (" Its done !! ")
End Sub

Filter IEX Schedule Adherence Data

Sub Filter_unwanted()
'
' Macro3 Macro
' Macro recorded 4/4/2009 by Vijay
'

'
'' Add a new sheet and rename it to Total
Application.DisplayAlerts = False
Sheets("Dump").Select
Rows("2:2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
Range("A2").Select

Sheets("Total").Select
ActiveSheet.Delete
Sheets.Add
ActiveSheet.Name = "Total"
Sheets("Raw").Select

'''' Delete all Blank Rows
Columns("A:A").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.Delete Shift:=xlUp
'''' Delete all Blank Rows

'''' Delete all unwanted data
Range("A1").Select
Selection.AutoFilter
Selection.AutoFilter field:=1, Criteria1:="=*--:--*"
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Delete Shift:=xlUp
ActiveSheet.ShowAllData
Selection.AutoFilter field:=1, Criteria1:="=*----*"
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Delete Shift:=xlUp
ActiveSheet.ShowAllData
Selection.AutoFilter field:=1, Criteria1:="=*====*"
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Delete Shift:=xlUp
ActiveSheet.ShowAllData
Selection.AutoFilter field:=1, Criteria1:="=*____*"
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Delete Shift:=xlUp
ActiveSheet.ShowAllData
Selection.AutoFilter field:=1, Criteria1:="=*From*"
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Delete Shift:=xlUp
ActiveSheet.ShowAllData
Selection.AutoFilter field:=1, Criteria1:="=*MU:*"
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Delete Shift:=xlUp
ActiveSheet.ShowAllData
Selection.AutoFilter field:=1, Criteria1:="=*Printed*"
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Delete Shift:=xlUp
ActiveSheet.ShowAllData
Selection.AutoFilter field:=1, Criteria1:="=*Report Across*"
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Delete Shift:=xlUp
ActiveSheet.ShowAllData
Selection.AutoFilter field:=1, Criteria1:="=*Shift*"
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Delete Shift:=xlUp
ActiveSheet.ShowAllData
Selection.AutoFilter field:=1, Criteria1:="=*Sorted*"
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Delete Shift:=xlUp
ActiveSheet.ShowAllData
Selection.AutoFilter field:=1, Criteria1:="=*To:*"
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Delete Shift:=xlUp
ActiveSheet.ShowAllData
Selection.AutoFilter field:=1, Criteria1:="=*#NAME*"
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Delete Shift:=xlUp
ActiveSheet.ShowAllData
Selection.AutoFilter field:=1, Criteria1:="=*Unknown Activity*"
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Delete Shift:=xlUp
ActiveSheet.ShowAllData
Selection.AutoFilter field:=1, Criteria1:="=*Ended*"
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Delete Shift:=xlUp
ActiveSheet.ShowAllData
Selection.AutoFilter field:=1, Criteria1:="=*Activities*"
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Delete Shift:=xlUp
ActiveSheet.ShowAllData
Selection.AutoFilter field:=1, Criteria1:="=*MU -*"
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Delete Shift:=xlUp
ActiveSheet.ShowAllData
Selection.AutoFilter field:=1, Criteria1:="=*+/-*"
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Delete Shift:=xlUp
ActiveSheet.ShowAllData
Selection.AutoFilter field:=1, Criteria1:="="
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Delete Shift:=xlUp
ActiveSheet.ShowAllData
Selection.AutoFilter field:=1, Criteria1:="=*Date:*"
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Delete Shift:=xlUp
ActiveSheet.ShowAllData

Range("A1").Select
lstrow = Selection.End(xlDown).Row
i = lstrow
Do While i >= 1
On Error Resume Next
If Cells(i, 1) = "#NAME?" Then
Cells(i, 1).Select
Selection.Delete Shift:=xlUp
End If
Select Case Left(Cells(i, 1), 3)
Case "00:", "01:", "02:", "03:", "04:", "05:", "06:", "07:", "08:", "09:", "10:", "11:", "12:", "13:", "14:", "15:", "16:", "17:", "18:", "19:", "20:", "21:", "22:", "23:", "24:"
Cells(i, 1).Select
Selection.Delete Shift:=xlUp
End Select
i = i - 1
Loop

''' Remove Total to new sheet '''
Sheets("Raw").Select
Range("A1").Select
lstrow = Selection.End(xlDown).Row
ltr = 0
For i = 1 To lstrow
Sheets("Raw").Activate
st = Cells(i, 1).Text
If IsNumeric(Left(st, 6)) = True Or Left(st, 5) = "Total" Then
Cells(i, 1).Select
Selection.Copy
Sheets("Total").Activate
'Range("A1").Select
'ltr = Selection.End(xlDown).Row
'If ltr >= 65536 Then ltr = ltr + 1
Cells(i, 1).Select
'Selection.Paste
ActiveSheet.Paste
End If

Next i
Sheets("Total").Activate
Columns("A:A").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.Delete Shift:=xlUp

Sheets("Raw").Activate
'' delete total
Selection.AutoFilter field:=1, Criteria1:="=*Total*"
Rows("2:2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Delete Shift:=xlUp
ActiveSheet.ShowAllData


Range("A1").Select
Selection.AutoFilter
Selection.EntireColumn.Insert
Range("B1").Select
lstrow = Selection.End(xlDown).Row
For i = 1 To lstrow
s = Cells(i, 2).Text
If IsNumeric(Left(s, 6)) = True Then
Cells(i, 1).Select
ActiveCell.FormulaR1C1 = "=RC[1]"
End If
Next i
crow = ActiveCell.Row
mytag = 0
For j = crow To lstrow
s = Cells(j, 2).Text
If Left(s, 8) = "At Lunch" Then
mytag = mytag + 1
If mytag = 2 Then
todelrow = j
End If
End If
Next j
Rows(todelrow).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Delete Shift:=xlUp
Range("A1").Select

Rows("1:1").Select
Selection.Delete Shift:=xlUp
Range("B1").Select
lr1 = Selection.End(xlDown).Row
For t = 1 To lr1
s = Cells(t, 1).Text
''' we are searching for the EMP ID in IEX, if you have 4 digit emp id then replace Left(s,4)
If IsNumeric(Left(s, 6)) = True Then
myTag1 = s
ElseIf s = "" Then
Cells(t, 1).Value = myTag1
End If
Next t


Selection.AutoFilter
Columns("A:A").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Columns("B:B").Select
Selection.TextToColumns Destination:=Range("B1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(28, 1), Array(39, 1), Array(48, 1), Array(61, 1), _
Array(72, 1), Array(80, 1), Array(82, 1), Array(95, 1), Array(105, 1), Array(107, 1), Array _
(120, 1), Array(122, 1), Array(134, 1)), TrailingMinusNumbers:=True
Range("C:C,E:O").Select
'Range("E1").Activate
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Selection.AutoFilter
Range("C1").Select
Selection.AutoFilter field:=3, Criteria1:="="
Rows("1:1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Delete Shift:=xlUp
Range("A1").Select
Range("B1").Select
Selection.EntireColumn.Insert
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(6, 1)), TrailingMinusNumbers:=True
Range("A1").Select


Sheets("Total").Activate
Range("A1").Select
Selection.EntireColumn.Insert
Range("B1").Select
lrow = Selection.End(xlDown).Row
For k = 2 To lrow Step 2
Range("A" & k).Select
ActiveCell.FormulaR1C1 = "=R[-1]C[1]"
Next k
Columns("A:A").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Range("A1").Select
Selection.AutoFilter
Selection.AutoFilter field:=1, Criteria1:="="
Rows("1:1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Delete Shift:=xlUp
Columns("B:B").Select
Selection.Insert Shift:=xlToRight
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(6, 1)), TrailingMinusNumbers:=True
Columns("C:C").Select
Selection.TextToColumns Destination:=Range("C1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(5, 1), Array(36, 1), Array(52, 1), Array(61, 1), _
Array(72, 1), Array(82, 1)), TrailingMinusNumbers:=True
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select

Selection.EntireRow.Insert
ActiveCell.FormulaR1C1 = "A"
Range("B1").Select
ActiveCell.FormulaR1C1 = "B"
Range("C1").Select
ActiveCell.FormulaR1C1 = "C"
Range("D1").Select
ActiveCell.FormulaR1C1 = "D"
Range("E1").Select
ActiveCell.FormulaR1C1 = "E"
Range("F1").Select
ActiveCell.FormulaR1C1 = "F"
Range("G1").Select
ActiveCell.FormulaR1C1 = "G"
Range("H1").Select
ActiveCell.FormulaR1C1 = "H"
Range("A1").Select
Selection.AutoFilter
Range("C1").Select
Selection.AutoFilter field:=3, Criteria1:="<=1:00", Operator:=xlAnd
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Range("A1").Select

Sheets("Raw").Select
Cells.Select
Selection.Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Select

Sheets("Raw").Columns("x:x").ClearContents
Sheets("Raw").Columns("C:C").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("X1"), Unique:=True
d = Sheets("Raw").Range("x2").End(xlDown).Row

Range("A1").Select
Selection.EntireRow.Insert
ActiveCell.FormulaR1C1 = "A"
Range("B1").Select
ActiveCell.FormulaR1C1 = "B"
Range("C1").Select
ActiveCell.FormulaR1C1 = "C"
Range("D1").Select
ActiveCell.FormulaR1C1 = "D"
Range("A1").Select
Columns("A:A").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Columns.AutoFit
Range("A1").Select
Columns("A:E").Select
Selection.EntireColumn.Hidden = False
Range("A1").Select

Application.DisplayAlerts = True
MsgBox ("Its Done !!")

End Sub

Search file from a specific folder

Private Sub SearchFile()

Set fs = Application.FileSearch
With fs
.LookIn = Environ("userprofile") & Application.PathSeparator & "Desktop" & Application.PathSeparator & "Source File" & Application.PathSeparator
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then
Sheets("FilePath").Select
For i = 1 To .FoundFiles.Count
If (InStr(1, .FoundFiles(i), "Template") = 0) Then
Range("A" & (i + 1)).Value = .FoundFiles(i)

End If
Next i
Else
'MsgBox "There were no Binder files found."
End If
End With

Columns("A:A").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.Delete Shift:=xlUp
Selection.End(xlUp).Select

End Sub