Friday, July 9, 2010

Find Last Cell, Column And Row in Excel Worksheet

Hi All,

Please find below a small code snippet, which you can use to find the last Used Cell, Row or Column.

Public Function LastUsedCell() As Range
Dim rng As Range
Dim activeSht As Worksheet
On Error GoTo ErrHandler

Set activeSht = activeSheet

Set rng = activeSht.Range("A1").SpecialCells(xlCellTypeLastCell)

'return value
Set LastUsedCell = rng
Exit Function
ErrHandler:
Set LastUsedCell = Nothing
End Function

Public Function LastUsedRow() As Long
Dim rng As Range
Dim activeSht As Worksheet
On Error GoTo ErrHandler

Set activeSht = activeSheet

Set rng = activeSht.Range("A1").SpecialCells(xlCellTypeLastCell)

'return value
LastUsedRow = rng.Row
Exit Function
ErrHandler:
LastUsedRow = 0

End Function


Public Function LastUsedColumn() As Integer
Dim rng As Range
Dim activeSht As Worksheet
On Error GoTo ErrHandler

Set activeSht = activeSheet

Set rng = activeSht.Range("A1").SpecialCells(xlCellTypeLastCell)

'return value
LastUsedColumn = rng.Column
Exit Function
ErrHandler:
LastUsedColumn = 0

End Function


Hope this helps :)

Thanks,
Vikas

Thursday, July 1, 2010

Excel VBA : Loop through all the files and subfolders in a Folder

Hi All,

I write this function many many times in my projects. When we have to create a temporary folder which are specific to our application, then I normally have to loop through all the files in a folder and put some validations so that my code should not replace any previous temp or log files. So I thought to share a small snippet of Excel VBA code where I am trying to search all the files in a Folder ( and its subfolders too) and printing in an Excel Worksheet.

Private fileCounter As Integer
Private activeSht As Worksheet
'Display all the files in a folder. Searches all the sub folders.

'Prints Folder Names in Column A and and the file Names in Column B

Sub SearchFiles()
Dim pth As String
Dim fso As FileSystemObject
Dim baseFolder As Folder

pth = "C:\Projects\" 'the base path which has to be searched for Files
Set fso = New FileSystemObject

''check if the folder actually exists or not

If (Not (fso.FolderExists(pth))) Then
'the folder path is invalid. Exiting.
MsgBox "Invalid Path"
Exit Sub
End If

Set baseFolder = fso.GetFolder(pth)

fileCounter = 1
Set activeSht = ActiveSheet

activeSht.Range("A1").Value = "Folder Name"
activeSht.Range("B1").Value = "File Name"

On Error GoTo ErrHandler
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
PrintFileNames baseFolder

ErrHandler:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub


Sub PrintFileNames(baseFolder As Folder)
Dim folder_ As Folder
Dim file_ As File

For Each folder_ In baseFolder.SubFolders
'call recursive function.
PrintFileNames folder_
Next folder_

For Each file_ In baseFolder.Files
'print files here
activeSht.Range("A1").Offset(fileCounter, 0).Value = baseFolder.Path
activeSht.Range("B1").Offset(fileCounter, 0).Value = file_.Name
fileCounter = fileCounter + 1
Next file_
End Sub




The above code loops through all the subfolders and the files in a given folder and prints the folder names in Column A and the file Names in Column B.

HTH,
Vikas

Write Custom Functions in Excel.

Hi,

We all know that we can write Formulas in Excel. for example, =Sum(A1:A10) to sum the values present in range from A1 to A10. The summation is easy. Right??? But what if we want to tweak our requirements.

Let's assume we have a requirement, that we need to sum only those values which are divisible by 2. I have assumed a very basic example, although we can write an Excel Built in for this requirement, but I want to show to achieve this through Custom Function.

For example, I want to sum range A1 to A10. I will write a custom Function in Excel VBA. Open VBA editor, add Module 1 and add a function like following :



Public Function SumEvenValues(rng As Range) As Double
Dim sum As Double
Dim cell_ As Range

sum = 0

For Each cell_ In rng.Cells
If (IsNumeric(cell_.Value)) Then
'the value is numeric. Check the mod
If (cell_.Value Mod 2 = 0) Then
sum = sum + cell_.Value
End If
End If
Next cell_

SumEvenValues = sum

End Function



In your excel workbook, in Cell b1, type this : =SumEvenValues(A1:A10)

You will see that all the values which are divisible by 2 are summed up and the result is displayed in Cell B1. I have taken a very basic example to show it's use, which can be easily achived in Excel, but we may encounter to include those requirements which we may not be able to achieve within Excel only. So in such a case, VBA is used to handle all those requirements which Excel cannot handle.

HTH,
Vikas

Wednesday, April 14, 2010

Linking Two Pivot Tables

Hi all,

Recently, I was making a dashboard and I had to create two Pivot Tables. My conditional formatting was set in such a manner, that I needed to have both the pivot tables updated @ same time, and the items too, to be shown or hid @ the same time in both the pivot table.

To achieve this, I first noted down the fields which I had to filter. I had three fields to filter and these items were Name, Date, and Month. So I had to make the following code :


Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
'ExpectedHours

If (Target.Name = "MainPivot") Then
      Macro1
End If

End Sub

Sub Macro1()
'

'
'On Error Resume Next
'
Dim pivotSource As PivotTable
Dim pivotTarget As PivotTable
Dim sourceItem As PivotItem
Dim sourceField As PivotField
Dim targetItem As PivotItem
Dim targetField As PivotField

Set pivotSource = Sheet7.PivotTables("MainPivot")
Set pivotTarget = Sheet7.PivotTables("ExpectedHours")


Set targetField = pivotTarget.PivotFields("department")

targetField.ClearAllFilters
targetField.CurrentPage = Sheet7.Range("Department").Value


Set sourceField = pivotSource.PivotFields("Name")
Set targetField = pivotTarget.PivotFields("Name")

For Each sourceItem In sourceField.PivotItems

Set targetItem = GetPivotItemByName(targetField, sourceItem.Name)

If (Not (targetItem Is Nothing)) Then

If (targetItem.Visible <> sourceItem.Visible) Then
targetItem.Visible = sourceItem.Visible
End If
End If
Next sourceItem


Set sourceField = pivotSource.PivotFields("Date")
Set targetField = pivotTarget.PivotFields("Date")

For Each sourceItem In sourceField.PivotItems

Set targetItem = GetPivotItemByName(targetField, sourceItem.Name)

If (Not (targetItem Is Nothing)) Then

If (targetItem.Visible <> sourceItem.Visible) Then
targetItem.Visible = sourceItem.Visible
End If
End If
Next sourceItem


Set sourceField = pivotSource.PivotFields("Month")
Set targetField = pivotTarget.PivotFields("Month")

For Each sourceItem In sourceField.PivotItems

Set targetItem = GetPivotItemByName(targetField, sourceItem.Name)

If (Not (targetItem Is Nothing)) Then
If (targetItem.Visible <> sourceItem.Visible) Then
targetItem.Visible = sourceItem.Visible
End If

If (targetItem.ShowDetail <> sourceItem.ShowDetail) Then
targetItem.ShowDetail = sourceItem.ShowDetail
End If
End If
Next sourceItem
End Sub


Public Function GetPivotItemByName(field As PivotField, item As String) As PivotItem
On Error Resume Next
Dim pvItem As PivotItem

Set pvItem = Nothing

Set pvItem = field.PivotItems(item)

Set GetPivotItemByName = pvItem
End Function


Hope this helps :)

Thanks,
Vikas