Finding Credit and Debit Data and Creating Pivot

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

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":

Code:

---


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

---

Code:

---

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

---

Code:

---


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

---

PFA

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"

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

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

Hi Rahul,

Can you help to solve the Query?

Regards,

Prabhu

Hi Friends,

Can any help to fix this issue?

Regards,

Prabhu

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.

Code:

---


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

---

Hi,

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

Regards,

Prabhu

Prabhu
Hmmm-It moves data for me - that is odd.
Rasm