VBA rounding issue, and double run through

[rgottesman]

I am having trouble with my VBA code it appears that I need to run the code twice in order to have the code process all of the data. The code should first refresh all pivot tables then copy and paste the data from pivot table 1 to a worksheet. After pasting the data, all negative values need to be moved with their absolute value to the next cell. I need to run the code twice, the first time all of the pivot tables are refreshed and the data is copied but the negative numbers are not moved until the second time running the code, also the negative numbers that are moved are then rounded, which they should not be. Thank you in adavance.

<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit;">Sub pivotrefresh()'' pivotrefresh Macro'**********************************Store Variables****************************Dim PivotCurrent As WorksheetDim PivotAccrual As WorksheetDim NumDaysPivot As WorksheetDim TotalAccrual As WorksheetDim journal As WorksheetDim pt1 As PivotTableDim pt2 As PivotTableDim pt3 As PivotTableDim pt4 As PivotTableDim ptacct As PivotFieldDim ptitem As PivotItemDim currentmonth As RangeDim JE_Db2Cr As RangeDim cell As RangeDim AccrualAcct As RangeDim inversecell As LongDim Lastrow As Long'**********************************Set Variables****************************'Titled worksheetsSet PivotCurrent = Sheets("PIVOT Current")Set PivotAccrual = Sheets("Pivot Accrual")Set NumDaysPivot = Sheets("#of DAYS PIVOT")Set TotalAccrual = Sheets("TOTAL Accrual")Set journal = Sheets("Journal")Set TotalAccrual = Sheets("Total Accrual")'Titled pivot tables in all of the workbookSet pt1 = PivotCurrent.PivotTables("pivotcurrent")Set pt2 = PivotAccrual.PivotTables("pivotaccrual")Set pt3 = NumDaysPivot.PivotTables("numberdays")Set pt4 = TotalAccrual.PivotTables("accrual")'Titled pivot field in pivot currentSet ptacct = pt1.PivotFields("G/L ACCOUNT NUMBER")'Titled named rangesSet currentmonth = Range("currentmonth")Set JE_Db2Cr = Range("JE_Db2Cr")Set AccrualAcct = Range("AccrualAcct")'**********************************Refresh Pivottables**************************** 'cleared extraneous left over data pt1.PivotCache.MissingItemsLimit = xlMissingItemsNone pt2.PivotCache.MissingItemsLimit = xlMissingItemsNone pt3.PivotCache.MissingItemsLimit = xlMissingItemsNone pt4.PivotCache.MissingItemsLimit = xlMissingItemsNone'refreshed all pivot tables in workbook in order pt1.RefreshTable pt2.RefreshTable pt3.RefreshTable pt4.RefreshTable '**********************************Copy data from pt1 to Journal tab**************************** For Each ptitem In ptacct.PivotItems If Len(ptitem.Name) > 2 And IsNumeric(ptitem.Name) Then ptacct.PivotItems(ptitem.Name).Visible = True Else ptacct.PivotItems(ptitem.Name).Visible = False End If Next ptitem '**********************************Posting Current Month JE**************************** currentmonth.Copy Destination:=journal.Range("a2") For Each cell In JE_Db2Cr If cell < 0 Then inversecell = Abs(cell.Value) cell.ClearContents cell.Offset(0, 1) = inversecell End If Next cell '**********************************Posting Current Month Accrual**************************** </code></pre>

 

[Jerry Sullivan]

Hi and Welcome to MrExcel,

Using Code Tags will preserve your code formatting. Here's a formatted version of your code...

Sub pivotrefresh()
'' pivotrefresh Macro'**********************************Store Variables****************************
Dim PivotCurrent As Worksheet
Dim PivotAccrual As Worksheet
Dim NumDaysPivot As Worksheet
Dim TotalAccrual As Worksheet
Dim journal As Worksheet
Dim pt1 As PivotTable
Dim pt2 As PivotTable
Dim pt3 As PivotTable
Dim pt4 As PivotTable
Dim ptacct As PivotField
Dim ptitem As PivotItem
Dim currentmonth As Range
Dim JE_Db2Cr As Range
Dim cell As Range
Dim AccrualAcct As Range
Dim inversecell As Long
Dim Lastrow As Long
'**********************************Set Variables****************************
'Titled worksheets
Set PivotCurrent = Sheets("PIVOT Current")
Set PivotAccrual = Sheets("Pivot Accrual")
Set NumDaysPivot = Sheets("#of DAYS PIVOT")
Set TotalAccrual = Sheets("TOTAL Accrual")
Set journal = Sheets("Journal")
Set TotalAccrual = Sheets("Total Accrual")
'Titled pivot tables in all of the workbook
Set pt1 = PivotCurrent.PivotTables("pivotcurrent")
Set pt2 = PivotAccrual.PivotTables("pivotaccrual")
Set pt3 = NumDaysPivot.PivotTables("numberdays")
Set pt4 = TotalAccrual.PivotTables("accrual")
'Titled pivot field in pivot current
Set ptacct = pt1.PivotFields("G/L ACCOUNT NUMBER")
'Titled named ranges
Set currentmonth = Range("currentmonth")
Set JE_Db2Cr = Range("JE_Db2Cr")
Set AccrualAcct = Range("AccrualAcct")
'**********************************Refresh Pivottables****************************
'cleared extraneous left over data
pt1.PivotCache.MissingItemsLimit = xlMissingItemsNone
pt2.PivotCache.MissingItemsLimit = xlMissingItemsNone
pt3.PivotCache.MissingItemsLimit = xlMissingItemsNone
pt4.PivotCache.MissingItemsLimit = xlMissingItemsNone
'refreshed all pivot tables in workbook in order
pt1.RefreshTable
pt2.RefreshTable
pt3.RefreshTable
pt4.RefreshTable
'**********************************Copy data from pt1 to Journal tab****************************
For Each ptitem In ptacct.PivotItems
   If Len(ptitem.Name) > 2 And IsNumeric(ptitem.Name) Then
      ptacct.PivotItems(ptitem.Name).Visible = True
   Else: ptacct.PivotItems(ptitem.Name).Visible = False
   End If
 Next ptitem
'**********************************Posting Current Month JE****************************
 currentmonth.Copy Destination:=journal.Range("a2")
 For Each cell In JE_Db2Cr
   If cell < 0 Then
      inversecell = Abs(cell.Value)
      cell.ClearContents
      cell.Offset(0, 1) = inversecell
   End If
 Next cell
   '**********************************Posting Current Month Accrual****************************
End Sub  '<< not in posted code

The rounding is happening because the variable inversecell is declared as a Long data type. You can fix that by declaring it as a Double data type.

Could you clarify what you mean by "it appears that I need to run the code twice in order to have the code process all of the data. "?
What happens when you just run it once?

One potential problem is the way you are setting the visible state of the PivotItems in ptacct.
Excel won't allow you to have all items hidden at the same time. It's possible under some scenarios, the code will try to hide all the previously visible items before encountering an item that meets the criteria for visible cells.

That might not be the reason for the problem you observed, because your posted code would throw an error instead of not processing all items (unless you have an Error Hander that isn't shown).

 

[rgottesman]

Thank you for the rounding fix!!

In terms of double running the code....

When I run the code through the first time, the pivot tables refresh, the data from the pivot table is copied and pasted, however, the last step of

'**********************************Posting Current Month JE****************************   
    currentmonth.Copy Destination:=journal.Range("a2")
    For Each cell In JE_Db2Cr
        If cell < 0 Then
            inversecell = Abs(cell.Value)
            cell.ClearContents
            cell.Offset(0, 1) = inversecell
        End If
    Next cell

does not run. When I run the code again the data is properly moved into the corresponding cell with the inverse value

 

[Jerry Sullivan]

To what does the named range "JE_Db2Cr" refer?

If it's a dynamic named range, then the problem is that you are assigning that range to variable JE_Db2Cr before the copy-paste occurs...

Set JE_Db2Cr = Range("JE_Db2Cr")

You could move that expression down to after the paste.

Alternatively you could define JE_Db2Cr based on the size of the copied range currentmonth...

 currentmonth.Copy Destination:=journal.Range("a2")
 Set JE_Db2Cr = journal.Range("a2").Resize(currentmonth.Rows.Count, _
   currentmonth.Columns.Count)
 For Each cell In JE_Db2Cr

 

[rgottesman]

Thank you so much, both solutions worked wonders.