PC Review


Reply
Thread Tools Rate Thread

copy and past numeric values only

 
 
Trip Bee
Guest
Posts: n/a
 
      11th Nov 2009
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/tutorials...ead-reque.aspx
 
Reply With Quote
 
 
 
 
Gary''s Student
Guest
Posts: n/a
 
      11th Nov 2009
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

--
Gary''s Student - gsnu200908


"Trip Bee" wrote:

> 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/tutorials...ead-reque.aspx
> .
>

 
Reply With Quote
 
John_John
Guest
Posts: n/a
 
      11th Nov 2009
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" *γγραψε:

>
> 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
>
>
> --
> joel
> ------------------------------------------------------------------------
> joel's Profile: http://www.thecodecage.com/forumz/member.php?userid=229
> View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=153003
>
> Microsoft Office Help
>
> .
>

 
Reply With Quote
 
Trip Bee
Guest
Posts: n/a
 
      15th Nov 2009
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

"Trip Bee" wrote:

Previous Posts In This Thread:

EggHeadCafe - Software Developer Portal of Choice
Encrypt / Hide Sensitive Global Configuration Data
http://www.eggheadcafe.com/tutorials...sensitive.aspx
 
Reply With Quote
 
 
 
Reply

Thread Tools
Rate This Thread
Rate This Thread:

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
Copy and Past Values AND Formatting AND Text KKD Microsoft Excel Misc 1 6th May 2010 06:25 PM
TO DELETE ONLY NUMERIC VALUES IN A CHARACTER AND NUMERIC CELL IN ramesh k. goyal - abohar Microsoft Excel Misc 1 28th Oct 2009 06:50 AM
Copy Past Values Ed Davis Microsoft Excel Misc 14 6th Oct 2009 03:24 AM
Copy and past as values =?Utf-8?B?UGl5dXNo?= Microsoft Excel Programming 2 9th Aug 2007 03:48 PM
Return Numeric Labels that have different Numeric Values Sam via OfficeKB.com Microsoft Excel Worksheet Functions 8 3rd Dec 2006 02:06 AM


Features
 

Advertising
 

Newsgroups
 


All times are GMT +1. The time now is 05:09 AM.