CDR Excel Macro

[jbarger]

I can't believe there is not many tools out there to cleanup CDR reports from call manager.

Here is a super simple tool to help.  Note it is only tested with CUCM 8.5. 

After you have the file you have to "Open" it in excel and use delimiter "comma" to get the fields imported into the correct columns.

Note: Sometimes there will be a junk column (like a single date entry that has it's own column) just make sure to delete it before running the script.

Turn on Developer mode, unhide personal.xlsb. Paste this into module1 and run it.

Sub CDR_Cleanup()
'
' CDR_Cleanup Macro
'

ActiveSheet.Columns("A:D").Delete

Columns(2).Insert
Columns("C:E").Delete
Columns("D:W").Delete
Columns("F:V").Delete
Columns("G:L").Delete
Columns("J:BC").Delete
Columns(7).Insert

Columns("B:B").NumberFormat = "ddd, mmm d, yyyy hh:mm"
Columns("G:G").NumberFormat = "ddd, mmm d, yyyy hh:mm"
Columns("C:E").NumberFormat = "0"

Columns("B:B").Formula = "=((A1-25200)/86400)+25569"
Columns("G:G").Formula = "=((F1-25200)/86400)+25569"

Range("B1") = "Call Start"
Range("C1") = "Calling Number"
Range("D1") = "Called Number"
Range("E1") = "Final Number"
Range("G1") = "Call End"
Range("H1") = "Duration"
Range("I1") = "Origin Device"
Range("J1") = "Destination Device"

Columns.AutoFit

Columns("A:A").Hidden = True
Columns("F:F").Hidden = True

End Sub

[Phill Johntony]

You are the man! This is a nice quick and dirty macro that works great.

[jbarger]

Now you need to find specific calls and copy them from sheet1 to sheet 2 (NOTE: sheets must be named sheet1 and sheet2. )

Sub FindCalls()
Dim strsearch As String, LastLine As Long, tocopy As Integer

Application.ScreenUpdating = False

strsearch = CStr(InputBox("enter the string to search for"))

LastLine = Range("A" & Rows.Count).End(xlUp).Row
j = 2

'copy the header row
Rows(1).Copy Destination:=Sheets(2).Rows(1)

For i = 2 To LastLine
    For Each c In Range("C" & i & ":E" & i)
        If InStr(c.Text, strsearch) Then
            tocopy = 1
        End If
    Next c
    If tocopy = 1 Then
        Rows(i).Copy Destination:=Sheets(2).Rows(j)
        j = j + 1
    End If
tocopy = 0
Next i

End Sub