heighlight dublicate valuele
Sub HighlightDuplicateValues()
Dim myRange As Range
Dim myCell As Range
Set myRange = Selection
For Each myCell In myRange
If WorksheetFunction.CountIf(myRange, myCell.Value) > 1
Then
myCell.Interior.ColorIndex = 36
End If
Next myCell
End Sub
set custom header
Sub CustomHeader()
Dim myText As String
myText = InputBox("Enter your text here",
"Enter Text")
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = myText
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
End With
End Sub
remove text wrap
Sub RemoveTextWrap()
Range("A1").WrapText = False
End Sub
unmerge cell
Sub UnmergeCells()
Selection.UnMerge
End Sub
open calculator
Sub OpenCalculator()
Application.ActivateMicrosoftApp Index:=0
End Sub
date in header setup
Sub DateInHeader()
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = "&D"
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
End With
End Sub
autofit column 1 st coading
Sub AutoFitColumns()
Cells.Select
Cells.EntireColumn.AutoFit
End Sub
autofit row 2nd coading
Sub AutoFitRows()
Cells.Select
Cells.EntireRow.AutoFit
End Sub
insert row as per your requirement
Sub InsertMultipleRows()
Dim i As Integer
Dim j As Integer
ActiveCell.EntireRow.Select
On Error GoTo Last
i = InputBox("Enter number of columns to insert",
"Insert Columns")
For j = 1 To i
Selection.Insert Shift:=xlToDown,
CopyOrigin:=xlFormatFromRightorAbove
Next j
Last: Exit Sub
End Sub
add columns as per your requirement
Sub InsertMultipleColumns()
Dim i As Integer
Dim j As Integer
ActiveCell.EntireColumn.Select
On Error GoTo Last
i = InputBox("Enter number of columns to insert",
"Insert Columns")
For j = 1 To i
Selection.Insert Shift:=xlToRight,
CopyOrigin:=xlFormatFromRightorAbove
Next j
Last: Exit Sub
End Sub
add serial no as per your requirement
Sub AddSerialNumbers()
Dim i As Integer
On Error GoTo Last
i = InputBox("Enter Value", "Enter Serial
Numbers")
For i = 1 To i
ActiveCell.Value = i
ActiveCell.Offset(1, 0).Activate
Next i
Last:Exit Sub
End Sub
