TRANSPOSE Column Value to Rows

suppose if you have multiple addresses in columns and you want to transpose it in rows then use below code

Try :
Sub test1()
Dim LR As Long, i As Long, j As Long, k As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
If Cells(1, 1).Value <> "" Then Cells(1, 1).EntireRow.Insert
Results = Array("Address :", "Area :", "Pin :", "Phone :")
Columns("A:A").Copy Destination:=ActiveSheet.Range("B1")
For p = 0 To UBound(Results, 1) Step 1
    Columns("B:B").Replace What:=Results(p), Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
      Next
j = 1
k = 3
For i = 1 To LR
    With Range("B" & i)
        If .Value = "" Then
            j = j + 1
            k = 3
        Else
            k = k + 1
            Cells(j, k).Value = .Value
        End If
    End With
Next i
Columns("B").Delete
Cells(1, 3) = "Company Name"
Cells(1, 4) = "Address"
Cells(1, 5) = "Area"
Cells(1, 6) = "Pincode"
Cells(1, 7) = "Phone No"
Columns("A:G").AutoFit
End Sub

Killing Excel File If wrong Password Entered

With this code, when you open the workbook you will get inputbox
if you enter wrong password then entire workbook will be deleted.
steps :
1. In Excel Workbook for which you want to set password
2. Go to developer Tab else Press Alt + F11(http://msdn.microsoft.com/en-us/library/bb608625.aspx)
3.Click on Visual Basic icon
4. Go to view click on project Explorer else precc Ctrl + R
5.Right click on this workbook
6. click on view code
7.Copy below code in Thisworkbook module

Private Sub Workbook_Open()
Dim strPwd As String
strPwd = Application.InputBox("Enter password")
'Enter your password here
If strPwd <> "Mahesh123" Then
Application.DisplayAlerts = False
ThisWorkbook.ChangeFileAccess xlReadOnly
Kill ThisWorkbook.FullName
ThisWorkbook.Close False
End If
End Sub

Find dupicate values within Column

if you want to highlight duplicate values in column then try below code

Sub test()
Dim LR As Long, i As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = LR To 2 Step -1
    If Range("A" & i).Value = Range("A" & i - 1).Value Then Range("A" & i).Font.ColorIndex = 3
Next i
End Sub

Separate files based on extension (.xls,.xlsx,.jpg,.pdf,.txt,.pptx)

If you want to separate files base on their extension use below code, enter the path of your folder,
and path where you want to copy the files
steps :
1. Press Alt + F11 or From Developer tab click on visual basic
2. Go to insert select module
3. copy below code in module

Public F As Object, d As Object, sw As Object
Sub test()
    Dim Fso As Object
    Set sw = CreateObject("Scripting.FileSystemObject")
    Set Fso = CreateObject("Scripting.FileSystemObject")
    'Enter path of folder
    Set RootFolder = Fso.GetFolder("C:\Users\MAHESH\Desktop\Temp\")
    FolderRead RootFolder
End Sub
Sub FolderRead(ByRef myFolder)
For Each F In myFolder.Files
    Var = F.Path
    If Right(F.Name, 4) = ".xls" Or Right(F.Name, 5) = ".xlsx" Then
    'enter the path where you want to copy file
    sw.copyFile F.Path, "C:\Users\MAHESH\Desktop\Temp\EXCEL\"
    End If
If Right(F.Name, 5) = ".jpg" Then
sw.copyFile F.Path, "C:\Users\MAHESH\Desktop\Temp\JPG\"
End If
If Right(F.Name, 4) = ".pdf" Then
sw.copyFile F.Path, "C:\Users\MAHESH\Desktop\Temp\PDF\"
End If
If Right(F.Name, 5) = ".txt" Then
sw.copyFile F.Path, "C:\Users\MAHESH\Desktop\Temp\TXT\"
End If
If Right(F.Name, 5) = ".pptx" Then
sw.copyFile F.Path, "C:\Users\MAHESH\Desktop\Temp\PPT\"
End If
Next F
For Each d In myFolder.SubFolders
FolderRead d
Next d
End Sub

Find content of folder

Insert below code in standard module & run the macro, you will get File name with extension in Column A,
File size in column B, Date & Time modified in column C.

Sub Directory()
Dim r As Integer, F As String, Directory As String
Directory = "C:\Users\MAHESH\Desktop\Temp\"
r = 1
Cells(r, 1) = "FileName"
Cells(r, 2) = "Size"
Cells(r, 3) = "Date/Time"
Range("A1:c1").Font.Bold = True
'Get Directory
F = Dir(Directory)
Do While F <> ""
r = r + 1
Cells(r, 1) = F
Cells(r, 2) = FileLen(Directory & F)
Cells(r, 3) = FileDateTime(Directory & F)
'Get next File
F = Dir()
Loop
End Sub

Break the password of protected excel sheet

Steps :
1. Open Excel Workbook
2. Go to developer Tab (http://msdn.microsoft.com/en-us/library/bb608625.aspx)
3.Click on Visual Basic icon
4.Go to Insert then Click on Module
5. Copy below code in Module
6.Open the workbook & select sheet, which you want to Unprotect
7. Run the Macro

Sub PasswordBreaker()
  Dim i As Integer, j As Integer, k As Integer
  Dim l As Integer, m As Integer, n As Integer
  Dim i1 As Integer, i2 As Integer, i3 As Integer
  Dim i4 As Integer, i5 As Integer, i6 As Integer
  On Error Resume Next
  For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
  For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
  For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
  For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126
    
       
 ActiveSheet.Unprotect Chr(i) & Chr(j) & Chr(k) & _
      Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
      Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
  If ActiveSheet.ProtectContents = False Then
      MsgBox "One usable password is " & Chr(i) & Chr(j) & _
          Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
          Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
   ActiveWorkbook.Sheets(1).Select
   Range("a1").FormulaR1C1 = Chr(i) & Chr(j) & _
          Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
          Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
       Exit Sub
  End If
  Next: Next: Next: Next: Next: Next
  Next: Next: Next: Next: Next: Next
End Sub

Find systems environment Information with vb

"Environ" : This Function return various Environment details ,all the Strings associated with an operating systems environment variables
This code is useful if you need to obtain info about your users operating system. The code loops through all the Environment variables available, and returns the name of the variable, and the string value associated with it. The Environ function is used to obtain things like the Windows Username, Userprofile, System root, etc

To Find User Name & Computer Name :

Sub envn()
MsgBox Environ("Username")
MsgBox Environ("Computername")
End Sub

To Find system Info :
Sub env()
Dim i As Long
Sheets.Add
For i = 1 To 56
    Cells(i, 1).Value = Environ(i)
Next i
Columns("A").AutoFit
End Sub

Determine physical address (MAC Address) of PC

Every network interface has a MAC address (Media Access Controller) also known as the physical address. This is the actual hardware address that the lowest level of the network uses to communicate.
The MAC address is used to assign the TCP/IP address by means of DHCP (Dynamic Host Configuration Protcol). For that reason, we need the MAC address of a machine so that it can be properly, and easily configured for the network.
You can enter ipconfig/all in cmd prompt and find Physical address i.e MAC address
vb code Try :
Sub MAC()
Dim strCom As String
Dim objWMIService As Object
Dim colAdapters As Object
Dim objAdapter As Object
strCom = "."
Set objWMIService = GetObject _
("winmgmts:" & "!\\" & strCom & "\root\cimv2")
Set colAdapters = objWMIService.ExecQuery _
("Select * from Win32_NetworkAdapterConfiguration Where IPEnabled = True")
For Each objAdapter In colAdapters
MsgBox "Physical address : " & objAdapter.MACAddress
Next objAdapter
End Sub

Open & Close CD Drawer from Excel

I found this on net, its amazing !



Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" _
(ByVal lpCommandString As String, ByVal lpReturnString As String, _
ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

Public Sub OpenCDDoor()
Call mciSendString("set CDAudio door open", "", 0, 0)
End Sub

Public Sub CloseCDDoor()
Call mciSendString("set CDAudio door closed", "", 0, 0)
End Sub

Excel Can Speak

Sub Speak()
Application.Speech.Speak Range("A1")
End Sub

To Find the last used row & column

Sub LastRC()

Dim LR, LC
LR = Cells(Rows.Count, 1).End(xlUp).Row
LC = Cells(1, Columns.Count).End(xlToLeft).Column
MsgBox LR
MsgBox LC
End Sub

Find columns Names And CONCATENATE with quama separated

Excel vb does not provides a function called Application.WorksheetFunction.CONCATENATE
If you want to find particular columns and combine the contents of columns cells with quama separated.you can use below vb code
For instance, let's say you wanted to Find columns with header FirstName,MiddleName,LastName,Product and add together the contents of columns cells,
separate them by a quama,if your last column contain blank rows or its blank, the formula will be drag till end of column.
All you need to do is put the below code in vb module.Run the Macro.
New column "Concatcolumns" will be added to your data at end of columns. with concatenation of columns mention and quama separated


Sub CONCATENATE()
Dim r, rng, c As String
Dim LR As Long
Dim Found1, Found2, Found3, Found4 As Range
Dim lastcol, delcol As Long
'code by : Mahesh Parab
lastcol = Cells(1, Columns.Count).End(xlToLeft).Column
For delcol = lastcol To 1 Step -1
If Cells(1, delcol) = "Concatcolumns" Then _
     Cells(1, delcol).EntireColumn.Delete
Next
Set Found1 = Rows(1).Find(what:="FirstName", LookIn:=xlValues, lookat:=xlWhole)
Set Found2 = Rows(1).Find(what:="MiddleName", LookIn:=xlValues, lookat:=xlWhole)
Set Found3 = Rows(1).Find(what:="LastName", LookIn:=xlValues, lookat:=xlWhole)
Set Found4 = Rows(1).Find(what:="Product", LookIn:=xlValues, lookat:=xlWhole)
Cells(1, Columns.Count).End(xlToLeft).Select
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "Concatcolumns"
ActiveCell.Offset(1, 0).Select
c = "&"",""&"
ActiveCell.Value = "=" & Found1.Offset(1, 0).Address(False, False) & c & Found2.Offset(1, 0).Address(False, False) & _
c & Found3.Offset(1, 0).Address(False, False) & c & Found4.Offset(1, 0).Address(False, False)
r = Split(ActiveCell.Address, "$")(1)
rng = (":" & r)
LR = Cells(Rows.Count, "A").End(xlUp).Row
Selection.AutoFill Destination:=Range(r & ActiveCell.Row & rng & LR)
End Sub