Friday, January 31, 2014

Sort IP Address

Option Explicit
Dim rowcount As Long, myrng As Range, cell As Object, cell1 As Object



Sub sortIPAddress()
rowcount = ThisWorkbook.Sheets(1).Range("A1").End(xlDown).Row
Set myrng = ThisWorkbook.Sheets(1).Range("A1:A" & rowcount)
    For Each cell In myrng
      cell.Offset(0, 1) = WorksheetFunction.Substitute(cell, ".", "")
      cell.NumberFormat = "#"
   
    Next
 
    ThisWorkbook.Sheets(1).Range("B1:B" & rowcount).Sort key1:=Range("B1"), Header:=xlYes
    For Each cell1 In ThisWorkbook.Sheets(1).Range("B2:B" & rowcount)
            cell1 = Mid(cell1, 1, 3) & "." & Mid(cell1, 4, 3) & "." & Mid(cell1, 7, 1) & "." & Mid(cell1, 8, Len(cell1) - 7)
         
    Next
    ThisWorkbook.Sheets(1).Range("B1:B" & rowcount).Columns.AutoFit
End Sub




Friday, January 24, 2014

Lock/Unlock Range with Criteria

Sub showParameter()
 
    If ThisWorkbook.Sheets(2).Range("J1") = 1 Then
       With ThisWorkbook.Worksheets(1)
                .Protect Password:="123india", UserInterfaceonly:=True, DrawingObjects:=False, Contents:=True, AllowFormattingCells:=True, AllowFormattingRows:=True, AllowFormattingColumns:=True
                .Cells.Locked = False
                .Range("A1:E50").Locked = True
                .EnableSelection = xlNoRestrictions
                .EnableOutlining = True
      End With
    ElseIf ThisWorkbook.Sheets(2).Range("J1") = 2 Then
        With ThisWorkbook.Worksheets(1)
                .Protect Password:="123india", UserInterfaceonly:=True, DrawingObjects:=False, Contents:=True, AllowFormattingCells:=True, AllowFormattingRows:=True, AllowFormattingColumns:=True
                .Cells.Locked = False
                .Range("A1:E50").Locked = True
                .EnableSelection = xlNoRestrictions
                .EnableOutlining = True
      End With
    End If

End Sub

Wednesday, January 22, 2014

Convert Excel file to *.CSV

Option Explicit
Dim rowcount As Long, filepath As String
Sub convertoCSV()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    rowcount = ThisWorkbook.Sheets(1).Range("A1").End(xlDown).Row
    With Application.FileDialog(msoFileDialogFolderPicker)
            .Title = "Select a path to store file"
            If .Show = True Then
                filepath = .SelectedItems(1) & "\"
                'converting into text format
                ThisWorkbook.Sheets(1).Range("A:A").NumberFormat = "@"
                ThisWorkbook.SaveAs Filename:=filepath & "Somu.csv", FileFormat:=xlCSV, CreateBackup:=False
         
            Else
                MsgBox "Folder for *.CSV file not selected"
            End If
 
    End With


End Sub

Sunday, January 19, 2014

Cut & Paste using VBA Code

Task for attached link:
https://drive.google.com/file/d/0B23eJ2xd9ODyUEtOVk4zRWt4VDA/edit?usp=sharing

Want to cut all these HQ names from column B and paste them to the very next column C


VBA Code



Option Explicit
Dim lookupval As String, myrng As Range, firstaddress As String
Sub copyHOnamelist()

lookupval = "HQ Name:"
With ThisWorkbook.Sheets(1).Range("A:A")
Set myrng = .Find(lookupval, LookIn:=xlValues)

    
    If Not myrng Is Nothing Then
        firstaddress = myrng.Address
            Do
                
                myrng.Offset(0, 1).Cut Destination:=myrng.Offset(0, 2)
                Set myrng = .FindNext(myrng)
                
                     
        
                
            Loop While Not myrng Is Nothing And myrng.Address <> firstaddress
            
    End If
End With

End Sub

Monday, January 6, 2014

VBA Code to Split Word

Sl. No.  Name with No Space Output
1 RahulSaxena Rahul Saxena
2 PramodSingh Pramod Singh
3 ManishSharma Manish Sharma
4 DhirenMathur Dhiren Mathur
5 RavindraKumarJena Ravindra Kumar Jena
6 RamSinghTohan Ram Singh Tohan
7 SurjitSinghManhas Surjit Singh Manhas




Function splitWord(myval As String)
Dim tiny As String, finalword As String
finalword = myval
    For i = 1 To Len(myval)
        
        tiny = Mid(myval, i, 1)
            If (tiny = StrConv(tiny, vbUpperCase)) Then
            finalword = WorksheetFunction.Substitute(finalword, tiny, " " & tiny)
            
            End If
    Next
    splitWord = WorksheetFunction.Trim(finalword)
End Function

Friday, January 3, 2014

Create PivotTable with Criteria In VBA


Dim pvttable As PivotTable
Private Sub worksheet_change(ByVal target As Range)
    If target.Address = ThisWorkbook.Sheets("Soum").Range("C3").Address Then
        Select Case ThisWorkbook.Sheets("Soum").Range("C3")
            Case "Daily Report"
               Call createdailyReport
            Case "Weekly Report"
               Call createdweeklyReport
            Case "Monthly Report"
                Call createdmonthlyReport
 
        End Select
     
    End If
End Sub

Sub createdailyReport()
On Error Resume Next
Application.ScreenUpdating = False
For Each pvttable In ThisWorkbook.Sheets("Soum").PivotTables
    ThisWorkbook.Sheets("Soum").Range(pvttable.TableRange2.Address).Delete

Next
ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=ThisWorkbook.Sheets("Dump").Range("A2").CurrentRegion.Address).CreatePivotTable tabledestination:=ThisWorkbook.Sheets("Soum").Range("C6"), tablename:="Pivottable1"
    With ThisWorkbook.Sheets("Soum").PivotTables("Pivottable1")
        .PivotFields("Date").Orientation = xlRowField
        .PivotFields("Agent Name").Orientation = xlPageField
        '
        .PivotFields("ACD Calls").Orientation = xlDataField
     
        .PivotFields("Avg ACD Time").Orientation = xlDataField
        .PivotFields("Sum of ACD Calls").Caption = "Total ACD Calls"
        .PivotFields("Sum of Avg ACD Time").Caption = "Average ACD Time"


    End With
End Sub

Sub createdmonthlyReport()
On Error Resume Next
Application.ScreenUpdating = False
For Each pvttable In ThisWorkbook.Sheets("Soum").PivotTables
    ThisWorkbook.Sheets("Soum").Range(pvttable.TableRange2.Address).Delete

Next
ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=ThisWorkbook.Sheets("Dump").Range("A2").CurrentRegion.Address).CreatePivotTable tabledestination:=ThisWorkbook.Sheets("Soum").Range("C6"), tablename:="Pivottable1"
    With ThisWorkbook.Sheets("Soum").PivotTables("Pivottable1")
        .PivotFields("Date").Orientation = xlRowField
        Sheets("Soum").Range("C8").Select
        Selection.Group Start:=True, End:=True, Periods:=Array(False, False, False, False, True, False, False)
        .PivotFields("Agent Name").Orientation = xlPageField
        '.PivotFields("ACD Calls").Orientation = xlColumnField
        .PivotFields("ACD Calls").Orientation = xlDataField
     
        .PivotFields("Avg ACD Time").Orientation = xlDataField
        .PivotFields("Sum of ACD Calls").Caption = "Total ACD Calls"
        .PivotFields("Sum of Avg ACD Time").Caption = "Average ACD Time"
       ' .PivotFields("Date").LabelRange.Group Start:=True, End:=True, Periods:=Array(False, False, False, _
        'False, True, False, False)



    End With
End Sub

Sub createdweeklyReport()
'On Error Resume Next
Application.ScreenUpdating = False
For Each pvttable In ThisWorkbook.Sheets("Soum").PivotTables
    ThisWorkbook.Sheets("Soum").Range(pvttable.TableRange2.Address).Delete

Next
ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=ThisWorkbook.Sheets("Dump").Range("A2").CurrentRegion.Address).CreatePivotTable tabledestination:=ThisWorkbook.Sheets("Soum").Range("C6"), tablename:="Pivottable1"
    With ThisWorkbook.Sheets("Soum").PivotTables("Pivottable1")
        .PivotFields("Date").Orientation = xlRowField
        Sheets("Soum").Range("C8").Select
        Selection.Group Start:=True, End:=True, by:=7, Periods:=Array(False, _
        False, False, True, False, False, False)
        .PivotFields("Agent Name").Orientation = xlPageField
        '.PivotFields("ACD Calls").Orientation = xlColumnField
        .PivotFields("ACD Calls").Orientation = xlDataField
     
        .PivotFields("Avg ACD Time").Orientation = xlDataField
        .PivotFields("Sum of ACD Calls").Caption = "Total ACD Calls"
        .PivotFields("Sum of Avg ACD Time").Caption = "Average ACD Time"
       ' .PivotFields("Date").LabelRange.Group Start:=True, End:=True, Periods:=Array(False, False, False, _
        'False, True, False, False)



    End With
End Sub


For file:

https://drive.google.com/file/d/0B23eJ2xd9ODybUFMaEVYbnE4WDQ/edit?usp=sharing