Macro to Calculate Efficiency of Spend

This macro was used in a spreadsheet to calculate the efficiency of marketing spend across many different channels. You can add easily adapt this macro to work for your own particular calculations.
' EfficiencyOfSpend Macro
' Pending the type of metric (e.g., CPI, visits), this function will calculate whether or not you are on or off target.
'
' Keyboard Shortcut: Ctrl+Shift+I
'

 
If KpiType = "CPI" Then
 
    'If Target = 0 Then EfficiencyOfSpend = 0

    If Target > ActualValue Then
    EfficiencyOfSpend = (Target - ActualValue) / Target
 
 
    ElseIf Target < ActualValue Then
    EfficiencyOfSpend = (ActualValue - Target) / Target
    EfficiencyOfSpend = -1 * EfficiencyOfSpend
 
    ElseIf Target = ActualValue Then
    EfficiencyOfSpend = 1
 
    End If
End If
 
If KpiType = "Visits" Then
    MsgBox "clickvisitetc"
    If Target < ActualValue Then
    EfficiencyOfSpend = (ActualValue - Target) / Target
 
    ElseIf Target > ActualValue Then
    EfficiencyOfSpend = (ActualValue - Target) / Target
 
    ElseIf Target = ActualValue Then
    EfficiencyOfSpend = 1
    End If
End If
 
If KpiType = "Impressions" Then
    MsgBox "clickvisitetc"
    If Target < ActualValue Then
    EfficiencyOfSpend = (ActualValue - Target) / Target
 
    ElseIf Target > ActualValue Then
    EfficiencyOfSpend = (ActualValue - Target) / Target
 
    ElseIf Target = ActualValue Then
    EfficiencyOfSpend = 1
    End If
End If
 
If KpiType = "Clicks" Then
    MsgBox "clickvisitetc"
    If Target < ActualValue Then
    EfficiencyOfSpend = (ActualValue - Target) / Target
 
    ElseIf Target > ActualValue Then
    EfficiencyOfSpend = (ActualValue - Target) / Target
 
    ElseIf Target = ActualValue Then
    EfficiencyOfSpend = 1
    End If
End If
 
 
 
End Function
Posted in VB

Highlight Rows in a Range that Meet Some Criteria

Option Explicit
Sub highlight()
 
' SelectValues Macro
' Selects values that will become criteria for shading rows
'
' Keyboard Shortcut: Ctrl+Shift+U
'
    'First, read in the values for shading
    Dim l As Double
    Dim m As Double
 
    l = Sheets("Criteria").Range("B2").Value
    m = Sheets("Criteria").Range("B3").Value
 
   'Set up variables that you'll need for below code
   Dim c As Range
   Dim r As Range
   Dim n As Double
 
   'Input Range to be evaluated
   Set r = Application.InputBox(prompt:="Input your range", Type:=8)
 
   'On error in below loop, just keep going
   On Error Resume Next
 
   'loop through all the values in the range
   For Each c In r
 
      'convert to number if value happens to be text
      c = Val(c)
 
      'evaluates and colors rows based on your criteria spreadsheet
      If c > l And c < 0 Then c.EntireRow.Interior.ColorIndex = 6
      If c < l And c > m Then c.EntireRow.Interior.ColorIndex = 44
      If c < m Then c.EntireRow.Interior.ColorIndex = 3
 
   Next c
 
End Sub
Posted in VB

Count Unique Objects in a Range

Sub UniqueReport()
 
Application.ScreenUpdating = True
Dim dict As Object
Set dict = CreateObject("scripting.dictionary")
Dim varray As Variant, element As Variant
 
varray = Application.InputBox(prompt:="Input your range", Type:=8)
 
'Generate unique list and count
For Each element In varray
    If dict.exists(element) Then
        dict.Item(element) = dict.Item(element) + 1
    Else
        dict.Add element, 1
    End If
Next
 
'Paste report somewhere
Sheet2.Range("A1").Resize(dict.Count, 1).Value = _
    WorksheetFunction.Transpose(dict.keys)
Sheet2.Range("B1").Resize(dict.Count, 1).Value = _
    WorksheetFunction.Transpose(dict.items)
 
Application.ScreenUpdating = True
End Sub
Posted in VB