The value in the field should not disappear after refreshing a file

[rajagopalanpb]

Hi
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
I have got this in a pivot table
<o></o>
Customer Total sales(USD)
<o></o>
30010 500.00
30041 2000.00
<o></o>
<o></o>
In another column I enter a comment for customer 30010(and leave the comment column for customer 30041 blank) as below
Data 1.xls
Customer Total sales(USD) Comment
<o></o>
30010 500.00 Test 1
30041 2000.00
Later on the content of the file changes as below:
<o></o>
Customer Total sales(USD)
<o></o>
30025 1500.00
30010 500.00
30041 2000.00
When the file is refreshed I would like to have comment as per the former file i.e the comment “Test 1” should appear against customer 30010 and similarly for any other customer that I enter the comment.It should be as below:
Customer Total sales(USD) Comment
<o></o>
30025 1500.00
30010 500.00 Test 1
Customer Total sales(USD) Comment
<o></o>
30041 2000.00
Is this possible using Excel VBA?If yes I would like to have the code please.
<o></o>
Thanks for your help
<o></o>
Raja
<o></o>
<o></o>
<o></o>

 

[rajagopalanpb]

Hi Andrew

its PivotTable2

Thanks for your help

Raja

 

[Andrew Poulsom]

So in the code I posted change "Pivot All GBP" to "PivotTable2" and "Customer" to "account".

 

[rajagopalanpb]

Thanks Andrew.Looks like it works.

Thanks for the help.

Raja

 

[rajagopalanpb]

Hi Andrew

I am getting these two error messages when I refresh the file:

Run-time error '1004':
Unable to get the match property of the WorksheetFunction class

The other one is

Run-time error '1004':
Application-defined or object-defined error

This error props up in Sub Worksheet_Calculate()

Thanks

Raja

 

[Andrew Poulsom]

Which lines are causing the errors?

 

[rajagopalanpb]

Hi Andrew

Hope you are well.

Sorry for the delayed response as I thought I had solved it but looks like I haven't.

The error is in this code"r = WorksheetFunction.Match(Cell.Value, .Columns(1), True)"

Also it appears from the code that the new comments is store in a new worksheet "cooments".Am I right?If yes,then currently this VBA code is not saving the new comments in the worksheet comments.

Let me know how to go about this.

Thanks for your help

Raja

 

[Andrew Poulsom]

In the code I posted there isn't a line that says:

r = WorksheetFunction.Match(Cell.Value, .Columns(1), True)

My code had:

r = WorksheetFunction.Match(Cell.Value, .Columns(1), False)

which can't fail because it depends on a Countif for Cell.Value in that range.

I think you had better post the code that is failing.

 

[rajagopalanpb]

Hi Andrew

Thanks for pointing it out.Maybe I had copied the wrong code.Its here that the code is failing

r = WorksheetFunction.Match(Cells(Target.Row, ColCustomer).Value, .Columns(1), False)

Let me know your views

Thanks a lot for the help

Raja

 

[Andrew Poulsom]

Please post the entire code, as you seem to have made changes to the code I posted.

 

[rajagopalanpb]

Hi Andrew

Sorry for the inconvenience

Here it is

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ShComments As Worksheet
    Dim ColCustomer As Integer
    Dim ColComments As Integer
    Dim r As Long
    If Target.Count > 1 Then Exit Sub
    With PivotTables("PivotTable2")
        ColCustomer = .PivotFields("Account").LabelRange.Column
        With .TableRange1
            ColComments = .Columns.Count - .Column + 2
        End With
    End With
    If Application.Intersect(Target, Columns(ColComments)) Is Nothing Then Exit Sub
    On Error Resume Next
    Set ShComments = Worksheets("Comments")
    If Err <> 0 Then
        Err.Clear
        Set ShComments = Worksheets.Add(After:=Me)
        Me.Activate
        With ShComments
            ShComments.Name = "Comments"
            .Cells(1, 1).Value = "Account"
            .Cells(1, 2).Value = "Comment"
        End With
    End If
    On Error GoTo 0
    With ShComments
        If WorksheetFunction.CountIf(.Columns(1), Cells(Target.Row, ColCustomer).Value) > 0 Then
            r = WorksheetFunction.Match(Cells(Target.Row, ColCustomer).Value, .Columns(1), False)
        Else
            r = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
            .Cells(r, 1).Value = Cells(Target.Row, ColCustomer).Value
        End If
            .Cells(r, 2).Value = Target.Value
    End With
End Sub
Private Sub Worksheet_Calculate()
    Dim ShComments As Worksheet
    Dim RngCustomer As Range
    Dim ColComments As Integer
    Dim Cell As Range
    Dim r As Long
    On Error Resume Next
    Set ShComments = Worksheets("Comments")
    If Err <> 0 Then
        Err.Clear
        Exit Sub
    End If
    On Error GoTo 0
    Application.EnableEvents = False
    With PivotTables("Pivot All GBP")
        Set RngCustomer = .PivotFields("Account").DataRange
        With .TableRange1
            ColComments = .Columns.Count - .Column + 2
        End With
    End With
    With ShComments
        For Each Cell In RngCustomer
            If WorksheetFunction.CountIf(.Columns(1), Cell.Value) > 0 Then
                r = WorksheetFunction.Match(Cell.Value, .Columns(1), False)
                Cells(Cell.Row, ColComments).Value = .Cells(r, 2).Value
            Else
                Cells(Cell.Row, ColComments).Value = ""
            End If
        Next Cell
    End With
    Application.EnableEvents = True
End Sub