copy and past numeric values only

[Trip Bee]

I have a spreadsheet which has text values and numeric values in different rows and columns. Is there a macro that can select a range (this range can be very large) and the only past the cells with a numeric value into one column? Any help is greatly appreciated

EggHeadCafe - Software Developer Portal of Choice
The Lowly HTTP HEAD Request
http://www.eggheadcafe.com/tutorial...9-f82f59991517/the-lowly-http-head-reque.aspx

 

[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

 

[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

 

[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" έγγÏαψε:

 

[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