Finding Credit and Debit Data and Creating Pivot

[Prabhu]

Hi Friends,


I have attached receivable statement. From that sheet I need to create two sheets once as Credit and debits.

Sheet "Credit" contains negate transaction (In Column "H") and sheet "Debit" contains positive transactions.

Vendor wise I need to create Pivot table for both sheet(Credit and Debit) as per the sheet attached.

Kindly help to create VBA code for the same.

Regards,

Prabhu

[littleiitin]

Hi Prabhu,

I have named this Data sheet name as "Raw Data", Created Two sheets "Credit" and "Debit"

Now do the Same:

Create a Module and Paste Below Code and Run First Code "CreatingPositiveNegativeSheet":

Sub CreatingPositiveNegativeSheet()
    
    ThisWorkbook.Worksheets("Credit").UsedRange.ClearContents
    ThisWorkbook.Worksheets("Debit").UsedRange.ClearContents
    With ThisWorkbook.Worksheets("Raw Data")
        If .AutoFilterMode = True Then .AutoFilterMode = False
        .Range("A1").CurrentRegion.Offset(1).AutoFilter Field:=8, Criteria1:="<0", _
        Operator:=xlAnd
        .UsedRange.SpecialCells(xlCellTypeVisible).Copy
        ThisWorkbook.Worksheets("Credit").Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
        
        If .AutoFilterMode = True Then .AutoFilterMode = False
        .Range("A1").CurrentRegion.Offset(1).AutoFilter Field:=8, Criteria1:=">=0", _
        Operator:=xlAnd
        .UsedRange.SpecialCells(xlCellTypeVisible).Copy
        ThisWorkbook.Worksheets("Debit").Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
        If .AutoFilterMode = True Then .AutoFilterMode = False
        Application.CutCopyMode = False
        
        Call CreditSheetPivote
        Call DebitSheetPivote
    End With
End Sub

Sub CreditSheetPivote()
    
    Dim rngPivote   As Range
    Dim rngDest     As Range
   With ThisWorkbook.Worksheets("Credit")
        Set rngPivote = .Range("A2").CurrentRegion.Offset(1)
        Set rngDest = .Range("T3")
        ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        rngPivote, Version:=xlPivotTableVersion10).CreatePivotTable _
        TableDestination:=rngDest, TableName:="PivotTable2", DefaultVersion _
        :=xlPivotTableVersion10
        
        With .PivotTables("PivotTable2").PivotFields("VENDOR")
            .Orientation = xlRowField
            .Position = 1
        End With
        .PivotTables("PivotTable2").AddDataField .PivotTables( _
            "PivotTable2").PivotFields("BOOKED"), "Sum of BOOKED", xlSum
    End With
    ThisWorkbook.ShowPivotTableFieldList = False


End Sub

Sub DebitSheetPivote()
    
    Dim rngPivote   As Range
    Dim rngDest     As Range
    
   With ThisWorkbook.Worksheets("Debit")
        Set rngPivote = .Range("A2").CurrentRegion.Offset(1)
        Set rngDest = .Range("T3")
        ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        rngPivote, Version:=xlPivotTableVersion10).CreatePivotTable _
        TableDestination:=rngDest, TableName:="PivotTable2", DefaultVersion _
        :=xlPivotTableVersion10

        With .PivotTables("PivotTable2").PivotFields("VENDOR")
            .Orientation = xlRowField
            .Position = 1
        End With
        .PivotTables("PivotTable2").AddDataField .PivotTables( _
            "PivotTable2").PivotFields("BOOKED"), "Sum of BOOKED", xlSum
    End With
    ThisWorkbook.ShowPivotTableFieldList = False


End Sub

[littleiitin]

PFA

[Prabhu]

Hi Friend,

Thanks, But am getting error message as "Run-time error '9'

"Subscript out of range"

Debug highlight the below line.

Plz help to resolve the same.

Regards,

Prabhu


" ThisWorkbook.Worksheets("Credit").UsedRange.ClearC ontents"

[littleiitin]

Prabhu,
I am seeing a space " ClearC ontents". Please remove it.
I have tried in my workbook.. It is running fine at my end.

Thanks
Rahul Singh

[Prabhu]

Hi Rahul,

I Am using the same workbook which you have uploaded.

I have inserted New date sheet and deleted the existing 3 sheets and run the macro.

But the same error is repeating. I have attached the workbook for your reference.

Regards,

Prabhu

[Prabhu]

Hi Rahul,

Can you help to solve the Query?

Regards,

Prabhu

[Prabhu]

Hi Friends,

Can any help to fix this issue?

Regards,

Prabhu

[Rasm]

Make sure to rename sheet1 to "Raw data" - also add code shown below - it will create the debit & credit sheets (if they dont already exists) - then the code runs fine - I have no idea if the data is right - but the code executes.

Sub CreatingPositiveNegativeSheet()
    
    Dim NewSheetX As Worksheet
    Astr = "NotExists"
    For ii = 1 To Worksheets.Count
        If Worksheets(ii).Name = "Credit" Then Astr = "Exists"
    Next ii
    If Astr = "NotExists" Then
        Set NewSheetX = Worksheets.Add    'This makes it active sheet
        ActiveSheet.Name = "Credit" ' Name of new 
    End If
    Astr = "NotExists"
    For ii = 1 To Worksheets.Count
        If Worksheets(ii).Name = "Debit" Then Astr = "Exists"
    Next ii
    If Astr = "NotExists" Then
        Set NewSheetX = Worksheets.Add    'This makes it active sheet
        ActiveSheet.Name = "Debit" ' Name of new sheet    
    End If
    ThisWorkbook.Worksheets("Raw Data").Activate 'This not need - but will make the Raw Data sheet the active sheet

[Prabhu]

Hi,

It is just creating two sheets. but data s are not moving from the data sheet(Raw data)

Regards,

Prabhu