copy and past numeric values only

G

Gary''s Student

Sub TripBee()
Dim r1 As Range, r2 As Range
Set r1 = Application.InputBox(prompt:="select source range", Type:=8)
Set r2 = Application.InputBox(prompt:="select destination cell", Type:=8)
For Each r In r1
If IsNumeric(r) Then
r.Copy r2
Set r2 = r2.Offset(1, 0)
End If
Next
End Sub
 
J

joel

It depends on what you are going numeric values. Dates are treated as
numbers so you will always get dattes along with the numbers.


I made the source sheet1 and the destination sheet 2.



set MyRange = Sheets("Sheet1").Range("A1:Z1000")

with sheets("Sheet2")
NewRow = 1
For Each cell in MyRange
if isnumeric(trim(cell)) then
Range("A" & NewRow) = val(trim(cell))
'The next line is optional
Range("A" & NewRow).numberformat = "0.00" ' this is 2
decimal places
NewRow = NewRow + 1
end if
next cell

end with
 
J

John_John

Is preferable to work with large blocks of cells to avoid those many loops.

Copy and paste the code below in a standar code module and run
"VerticalValues" proc.

'-----------------------------8<----------------------------------------

Option Explicit

Sub VerticalValues()
Dim rngS As Range
Dim rngT As Range

On Error Resume Next
Set rngS = Application.InputBox(prompt:= _
"Select source range.", Default:=Selection.Address, Type:=8)
If Not rngS Is Nothing Then
Set rngT = Application.InputBox(prompt:= _
"Select destination cell.", Default:=Selection.Address,
Type:=8)
On Error GoTo 0
If Not rngT Is Nothing Then
Call ValuesInColumn(rngS, rngT)
End If
End If
End Sub

Sub ValuesInColumn(ByVal rngSource As Range, ByVal rngTarget As Range)
Dim rngConstants As Range
Dim rngArea As Range
Dim rngCol As Range
Dim lngCells As Long

With rngSource
On Error Resume Next
Set rngSource = .SpecialCells(xlCellTypeFormulas, 1)
Set rngConstants = .SpecialCells(xlCellTypeConstants, 1)
If Not rngSource Is Nothing Then
Set rngSource = Application.Union(rngSource, rngConstants)
Else
Set rngSource = rngConstants
End If
On Error GoTo 0
End With

If Not rngSource Is Nothing Then
If rngSource.Count < Rows.Count Then
With rngTarget.Range("A1")
For Each rngArea In rngSource.Areas
For Each rngCol In rngArea.Columns
.Cells(lngCells + 1).Resize(rngCol.Cells.Count) = _
rngCol.Cells.Value
lngCells = lngCells + rngCol.Cells.Count
Next rngCol
Next rngArea
End With
Else
MsgBox "Too many cells!", vbExclamation
End If
Else
MsgBox "No cells were found!", vbExclamation
End If
End Sub

'-----------------------------8<----------------------------------------

John


Ο χÏήστης "joel" έγγÏαψε:
 
T

Trip Bee

thanks guys, much appreciated.



Gary''s Student wrote:

Sub TripBee()Dim r1 As Range, r2 As RangeSet r1 = Application.
11-Nov-09

Sub TripBee(
Dim r1 As Range, r2 As Rang
Set r1 = Application.InputBox(prompt:="select source range", Type:=8
Set r2 = Application.InputBox(prompt:="select destination cell", Type:=8
For Each r In r
If IsNumeric(r) The
r.Copy r
Set r2 = r2.Offset(1, 0
End I
Nex
End Su

-
Gary''s Student - gsnu20090

:

Previous Posts In This Thread:

EggHeadCafe - Software Developer Portal of Choice
Encrypt / Hide Sensitive Global Configuration Data
http://www.eggheadcafe.com/tutorial...361-335019cc9593/encrypt--hide-sensitive.aspx
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Enterprise Resource Leveling 6
find largest column width and ... 4
Macro to Find the Max ? 2
question about excel formulae 1
countifs 1
Using Excel mail-merge without Word 1
compile error 1
VB excel help needed 1

Top