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
nwk = ActiveWorkbook.Name
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
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