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

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

Back to XL VBA : A Way to create Utility functions to increase reusability

Hi there!

I normally create a Util Module every time I work on an Office Automation Project. I thought, people may be benefitted with it. Moreover, I will not have to create it again. I will copy it from here only ;)

Public Function SheetExists(wkb As Workbook, shtName As String) As Boolean
    Dim sht As Worksheet
    
    Set sht = Nothing
    On Error GoTo errHandler
    Set sht = wkb.Worksheets(shtName)
    SheetExists = True
    Exit Function

errHandler:
    SheetExists = False
End Function

Public Function GetSheet(wkb As Workbook, shtName As String) As Worksheet
    Dim sht As Worksheet
    
    Set sht = Nothing
    If (SheetExists(wkb, shtName)) Then
        Set sht = wkb.Worksheets(shtName)
    End If
    
    Set GetSheet = sht
End Function


Public Function RangeExists(wkSht As Worksheet, rngName As String) As Boolean
    Dim rng As Range
    
    Set rng = Nothing
    On Error GoTo errHandler
    Set rng = wkSht.Range(rngName)
    RangeExists = True
    Exit Function

errHandler:
    RangeExists = False
End Function

Public Function GetRange(wkSht As Worksheet, rngName As String) As Range
    Dim rng As Range
    
    Set rng = Nothing

    If (RangeExists(wkSht, rngName)) Then
        Set rng = wkSht.Range(rngName)
    End If
    
    Set GetRange = rng
End Function


Public Function GetRows(wkSht As Worksheet, Optional columnName As String = "A") As Long
    Dim rowCounter As Long
    Dim runLoop As Boolean
    Dim startRange As Range
    
    rowCounter = 0
    runLoop = True
    
    Set startRange = wkSht.Range(columnName & "1")
    
    While runLoop
        If (Len(startRange.Offset(rowCounter, 0).Value) > 0) Then
            rowCounter = rowCounter + 1
        Else
            runLoop = False
        End If
    Wend
    
    GetRows = rowCounter
    
End Function

Public Function GetColumns(wkSht As Worksheet, Optional rowNum As String = "1") As Long
    Dim colCounter As Long
    Dim runLoop As Boolean
    Dim startRange As Range
    
    colCounter = 0
    runLoop = True
    
    Set startRange = wkSht.Range("A" & rowNum)
    
    While runLoop
        If (Len(startRange.Offset(0, colCounter).Value) > 0) Then
            colCounter = colCounter + 1
        Else
            runLoop = False
        End If
    Wend
    
    GetColumns = colCounter
    
End Function

Thanks,
Vikas

Designing a Button in WPF - "Simplest yet cool Button"

Hi All,

I have seen a lot of button templates which offer a cool looking styles by overriding the complete button template. Just to give a small style to a button can be complicated as far as overriding the template is concerned. I tried to build a button something like this :



An option could be, to include a new style for my button and override the template. But do we really need to do that???? I don't think so. The button which you are seeing in the Image is actually not a button, it is actually a border object filled with Alice Blue color, and with the corner radius set to 5. There is a textblock object inside the border so that it can contain some text. I didn't use label for that because textblock is lighter than a label.




Now, this control is not yet completed because it doesn't give any notification whenever it is clicked. So I had to include some animation to this button.




Here, I have opted to use code behind to run my animation. Like shown in the figure below :




After including the above code lines, you can see that the border looks like a button and animates as well once you click the control.

HTH,
Vikas