write at exceltoexplore@gmail.com : Report Automation|Dashboard in Excel| Provide Excel consulting through macro (VBA) automation |Financial Modeling | Ethical Hacking

Saturday 23 July 2011

Pivot table : on click create new workbook & save

with below code when you double click on any values in pivot table
the new workbook will be created & save in the same folder


copy below code in this workbook module

Private Sub Workbook_NewSheet(ByVal Sh As Object)
Dim nwk As String, sPath As String, sFileName As String
Sh.Move
nwk = ActiveWorkbook.Name
Workbooks(nwk).Activate
Workbooks(nwk).ActiveSheet.Name = Cells(2, 1).Value & "_" & Cells(2, 3).Value
'Save the new workbook
sPath = ThisWorkbook.Path & "\"
sFileName = ActiveSheet.Name
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs (sPath & sFileName)
ActiveWorkbook.Close True
End Sub

Wednesday 13 July 2011

Add Serial Number in Column Automatically

If you want to Add serial no in column A automatically once you enter data in column B then try below code
steps.
1. Right click on sheet tab
2. select view code
3. Paste below code in sheet module



Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long
For i = 2 To Cells(Rows.Count, "B").End(xlUp).Row
If Cells(i, "B").Value <> "" Then
Cells(i, "A").Value = i - 1
End If
Next i
End Sub

Monday 11 July 2011

Extract Number & Text from string

1. Go to developer Tab else Press Alt + F11(http://msdn.microsoft.com/en-us/library/bb608625.aspx)
2.Click on Visual Basic icon
3.Go to Insert click on Module
4.Paste below code in standard module

worksheet formulas as shown in images




'Below User Define Function extract Number from string
Function ExtractNumber(rng As Range)
Dim i As Integer
For i = 1 To Len(rng)
Select Case Asc(Mid(rng.Value, i, 1))
Case 0 To 64, 123 To 197
ExtractNumber = ExtractNumber & Mid(rng.Value, i, 1)
End Select
Next i
End Function

'Below User Define Function extract Text from string
Function ExtractText(stdText As String)
Dim str As String, i As Integer
stdText = Trim(stdText)
For i = 1 To Len(stdText)
If Not IsNumeric(Mid(stdText, i, 1)) Then
str = str & Mid(stdText, i, 1)
End If
Next i
ExtractText = str
End Function