Copying a number and pasting a truncated one?

Koontz

Board Regular
Joined
May 30, 2014
Messages
74
Does anyone know the VBA code for how to copy a number that goes out to 18 decimals from one spreadsheet and paste that number with

For instance, I have a number 52.945849949543435656 that I would my macro to paste into a new sheet as simply, 53.

My current code looks like this:

Cells.Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste

Any help would be much appreciated!

Thanks,
Ryan
 

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
Maybe add another line for the number format

Code:
Cells.Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Selection.NumberFormat = "0"
 
Upvote 0
Thanks for the response, but that didn't work... It gave me the exact same number.

-Ryan
 
Upvote 0
Thats a little surprising 'cos it works for me.

Is that all of your code or is there some other part to it?
 
Upvote 0
Nope, that was a chunk. The full code is below:

Sub SaveAs()
'This saves the WAL OLE when the account is run. This macro treats the acct number and date as a variable.


Sheets("Summary").Select
Cells.Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
ChDir "T:\0186\2a7\WAL Reports\"
ActiveWorkbook.SaveAs Filename:="T:\0186\2a7\WAL Reports\" & Range("B4") & "\" & Range("B4") & "_" & Format(Range("B5"), "mmddyy") & ".xlsx"
ActiveWorkbook.Close SaveChanges:=True
On Error Resume Next
If Dir("\\chifsvp07\data07\0186\Paperless Valuation Packages\Money Market Funds\Current Day Valuations\" & Range("B4") & "\AB01 WAL OLE with Cash.pdf") <> "" Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="\\chifsvp07\data07\0186\Paperless Valuation Packages\Money Market Funds\Current Day Valuations\" & Range("B4") & "\AB01 WAL OLE with Cash", Quality:=xlQualityMinimum, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End If
On Error GoTo 0




End Sub
 
Upvote 0
I have a number 52.945849949543435656 that I would my macro to paste into a new sheet as simply, 53. My current code looks like this:

Cells.Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste

Code:
Cells.Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Selection.NumberFormat = "0"

First, changing the format simply changes the appearance of a numeric value. It does not change the actual value. It is unclear whether that would meet Ryan's needs. (Ryan, what say you?)

[EDIT] Re: "does not change the actual value".... Unless the option "Precision is displayed" is set, which I do not recommend.

Second, any such "number" in an Excel cell must be text, since Excel displays only up to 15 significant digits of a truly numeric value. So Copy and Paste would result in text; and numeric formats do not alter the appearance of text, even if the text looks like a number.

Third, Ryan, if you have "a number" that you want to copy to "a new sheet", why are you copying all cells (1+ million in Excel 2007 and later!!) to a new workbook?

If you want to copy only one selected cell to a new worksheet, try:
Code:
Dim x As Double
x = Selection
Sheets.Add
ActiveCell = WorksheetFunction.Round(x, 0)
I use WorksheetFunction.Round because it rounds like Excel. VBA Round behaves differently if the value is exactly xxxx.5 and xxxx is even (divisible by 2).

If you truly want to copy all used cells to the same locations in a new workbook, try:
Code:
Sub doit()
    Dim v As Variant, nr As Long, nc As Long
    Dim rng As Range, i As Long, j As Long
    Dim oldCalc As Variant
    With Application
        oldCalc = .Calculation
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
    ActiveSheet.Copy    ' into Sheet1 of new workbook
    If ActiveSheet.UsedRange.Count = 1 Then
        ReDim v(1 To 1, 1 To 1) As Variant
        v(1, 1) = ActiveSheet.UsedRange
    Else
        v = ActiveSheet.UsedRange
    End If
    nr = UBound(v, 1)    ' number of used rows
    nc = UBound(v, 2)    ' number of used columns
    Set rng = ActiveSheet.UsedRange
    For i = 1 To nr: For j = 1 To nc
        If v(i, j) <> "" Then
            If IsNumeric(v(i, j)) Then
                rng(i, j) = WorksheetFunction.Round(v(i, j), 0)
            End If
        End If
    Next j, i
    With Application
        .EnableEvents = True
        .Calculation = oldCalc
        .ScreenUpdating = True
    End With
End Sub
That does not alter the format of cells whose value was rounded. They might be formatted as Text. If you want to change their format, change rounding code as follows:
Code:
                With rng(i, j)
                    .NumberFormat = "0"
                    .Value = WorksheetFunction.Round(v(i, j), 0)
                End With
 
Last edited:
Upvote 0
This is what the code should look like

Code:
Sub SaveAs()
'This saves the WAL OLE when the account is run. This macro treats the acct number and date as a variable.


Sheets("Summary").Select
    Cells.Select
    Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Selection.NumberFormat = "0"
    ChDir "T:\0186\2a7\WAL Reports\"
    ActiveWorkbook.SaveAs Filename:="T:\0186\2a7\WAL Reports\" & Range("B4") & "\" & Range("B4") & "_" & Format(Range("B5"), "mmddyy") & ".xlsx"
    ActiveWorkbook.Close SaveChanges:=True
    On Error Resume Next
    If Dir("\\chifsvp07\data07\0186\Paperless Valuation Packages\Money Market Funds\Current Day Valuations\" & Range("B4") & "\AB01 WAL OLE with Cash.pdf") <> "" Then
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="\\chifsvp07\data07\0186\Paperless Valuation Packages\Money Market Funds\Current Day Valuations\" & Range("B4") & "\AB01 WAL OLE with Cash", Quality:=xlQualityMinimum, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    End If
    On Error GoTo 0
End Sub
 
Upvote 0
Improvement, too late to edit....
Rich (BB code):
    If ActiveSheet.UsedRange.Count = 1 Then
        ReDim v(1 To 1, 1 To 1) As Variant
        v(1, 1) = ActiveSheet.UsedRange
    Else
        v = ActiveSheet.UsedRange
    End If
    nr = UBound(v, 1)    ' number of used rows
    nc = UBound(v, 2)    ' number of used columns
    Set rng = ActiveSheet.UsedRange
Better:
Rich (BB code):
    Set rng = ActiveSheet.UsedRange
    If rng.Count = 1 Then
        ReDim v(1 To 1, 1 To 1) As Variant
        v(1, 1) = rng
    Else
        v = rng
    End If
    nr = UBound(v, 1)    ' number of used rows
    nc = UBound(v, 2)    ' number of used columns
 
Upvote 0
PS....
Subject: Copying a number and pasting a truncated one?

I have a number 52.945849949543435656 that I would my macro to paste into a new sheet as simply, 53.

Your subject line says "truncate", but your example suggests "round". Which is it?

If you truly want to truncate -- resulting in 52, not 53 -- change WorksheetFunction.Round(...,0) to simply Int(...) in my responses.

(And yet another reason not to use range.NumberFormat="0", not that we need another reason. ;))
 
Upvote 0
First, changing the format simply changes the appearance of a numeric value. It does not change the actual value. It is unclear whether that would meet Ryan's needs. (Ryan, what say you?)

JoeU2004, the *appearance* is currently fine, I need to make sure that when you click on the cell, there are no places after the decimal.

Third, Ryan, if you have "a number" that you want to copy to "a new sheet", why are you copying all cells (1+ million in Excel 2007 and later!!) to a new workbook?

Well, because it all takes less than a second to run, so it never occurred to me actually. Haha

-Ryan
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,256
Members
448,557
Latest member
richa mishra

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top