How to Paste as Text and Keep leading zero. I am trying to convert this code to paste as text rather than value but it keeps giving me an error.
Your help will be much appreciated.
I want to keep the 0
using my below function.
Set rngA = .NumberFormat = "@"
then tried
If ra = 1 Then rngB.Resize(, rc).Value = rngA.PasteSpecial : Exit Sub
but nothing worked
Dim rngA As Range
Dim rngB As Range
Dim r As Range
Dim Title As String
Dim ra As Long
Dim rc As Long
On Error GoTo skip:
Title = "Copy Visible To Visible"
Set rngA = Application.Selection
Set rngA = Application.InputBox("Select Range To Copy Then click OK:", Title, rngA.Address, Type:=8)
Set rngB = Application.InputBox("Select Range To Paste (select the first cell only):", Title, Type:=8)
Set rngB = rngB.Cells(1, 1)
Application.ScreenUpdating = False
ra = rngA.Rows.Count
rc = rngA.Columns.Count
If ra = 1 Then rngB.Resize(, rc).Value = rngA.Value: Exit Sub
Set rngA = rngA.Cells(1, 1).Resize(ra, 1)
For Each r In rngA.SpecialCells(xlCellTypeVisible)
rngB.Resize(1, rc).Value = r.Resize(1, rc).Value
Do
Set rngB = rngB.Offset(1, 0)
Loop Until rngB.EntireRow.Hidden = False
Next
Application.GoTo rngB
Application.ScreenUpdating = True
Application.CutCopyMode = False
Exit Sub
skip:
If Err.Number <> 424 Then
MsgBox "Error found: " & Err.Description
End If
Application.ScreenUpdating = True
Application.CutCopyMode = False
Change this ...
rngB.Resize(1, rc).Value = r.Resize(1, rc).Value
... to this ...
rngB.Resize(1, rc).Value = "'" & r.Resize(1, rc).Value
Adding an apostrophe in front will instruct Excel to ignore what it thinks it should do for you and will preserve it's textual value and represent it as a string.
I can imagine you will have done this before in a cell manually. This also works in VBA and is a nice, easy way to achieve what you want.
Change this:
rngB.Resize(1, rc).Value = r.Resize(1, rc).Value
to this:
With rngB.Resize(1, rc)
.NumberFormat = "@"
.Value = r.Resize(1, rc).Value
End With
Edit #1
Your code suggests that you only skip hidden rows but ignore any hidden columns. It's faster to copy larger arrays in one go and if there is no hidden row then we don't need to read/write row by row.
I would replace this:
ra = rngA.Rows.Count
rc = rngA.Columns.Count
If ra = 1 Then rngB.Resize(, rc).Value = rngA.Value: Exit Sub
Set rngA = rngA.Cells(1, 1).Resize(ra, 1)
For Each r In rngA.SpecialCells(xlCellTypeVisible)
rngB.Resize(1, rc).NumberFormat = "@"
rngB.Resize(1, rc).Value = r.Resize(1, rc).Value
Do
Set rngB = rngB.Offset(1, 0)
Loop Until rngB.EntireRow.Hidden = False
Next
with this:
If rngA.Areas.Count > 1 Then Set rngA = rngA.Areas(1)
ra = rngA.Rows.Count
rc = rngA.Columns.Count
Set rngB = rngB.Resize(1, rc)
Dim i As Long: i = 0
Dim firstVisibleRow As Long: firstVisibleRow = 0
Dim lastVisibleRow As Long: lastVisibleRow = 0
Dim rCount As Long
Dim rngWrite As Range
Dim rngRead As Range
Dim isHidden As Boolean
For Each r In rngA.Rows
i = i + 1
isHidden = r.EntireRow.Hidden
If Not isHidden Then
If lastVisibleRow = 0 Then firstVisibleRow = i
lastVisibleRow = i
End If
If isHidden Or i = ra Then
If lastVisibleRow > 0 Then
Set rngWrite = rngB.Rows(firstVisibleRow)
If lastVisibleRow > firstVisibleRow Then
rCount = lastVisibleRow - firstVisibleRow + 1
Set rngWrite = rngWrite.Resize(rCount)
Set rngRead = r.Resize(rCount).Offset(-rCount + IIf(isHidden, 0, 1))
ElseIf isHidden Then
Set rngRead = rngA.Rows(i - 1)
Else
Set rngRead = r
End If
rngWrite.NumberFormat = "@"
rngWrite.Value = rngRead.Value
End If
End If
If isHidden Then lastVisibleRow = 0
Next r
The code is longer but more efficient.
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.