PDA

View Full Version : Copy Non Error values



jammer6_9
11-19-2011, 02:46 AM
I am trying to copy a fromulated range but i want to have the values only and excluding the non error #N/A. How can I do it? :help


Sub copy_not_error_values_only()


If Sheets("Monthly Source").Range("F2") = "HIGH RISK" Then

Sheets("Monthly Source").Range("G4:G161").ClearContents

'*** On this range I only want to copy and paste special values and excluding " #N/A " values since it range is formulated ***
Worksheets("Monthly Source").Range("C400:C5582").Copy _
Destination:=Worksheets("Monthly Source").Range("g4")


End Sub

Paul_Hossler
11-19-2011, 08:48 PM
I think you have to do it in pieces

You could probably eliminate some steps depending on your data

Of course, you need to adjust addresses, etc.



Option Explicit
Sub Macro1()
Dim rNumbers As Range, rText As Range, rLogical As Range, rArea As Range

Worksheets("sheet2").Select

Set rNumbers = Nothing
Set rText = Nothing
Set rLogical = Nothing

On Error Resume Next
Set rNumbers = Worksheets("sheet1").Range("A1:D10").SpecialCells(xlCellTypeFormulas, xlNumbers)
Set rText = Worksheets("sheet1").Range("A1:D10").SpecialCells(xlCellTypeFormulas, xlTextValues)
Set rLogical = Worksheets("sheet1").Range("A1:D10").SpecialCells(xlCellTypeFormulas, xlLogical)
On Error GoTo 0

If Not rNumbers Is Nothing Then
For Each rArea In rNumbers.Areas
rArea.Copy

Worksheets("sheet2").Range(rArea.Address).Select

Selection.PasteSpecial (xlPasteValues)
Selection.PasteSpecial (xlPasteFormats)
Next
End If

If Not rText Is Nothing Then
For Each rArea In rText.Areas
rArea.Copy

Worksheets("sheet2").Range(rArea.Address).Select

Selection.PasteSpecial (xlPasteValues)
Selection.PasteSpecial (xlPasteFormats)
Next
End If

If Not rLogical Is Nothing Then
For Each rArea In rLogical.Areas
rArea.Copy

Worksheets("sheet2").Range(rArea.Address).Select

Selection.PasteSpecial (xlPasteValues)
Selection.PasteSpecial (xlPasteFormats)
Next
End If
End Sub


Paul

jammer6_9
11-19-2011, 11:17 PM
Hi, thanks for the reply? What about the rArea? Is this the destination cell? Should I set it?

mikerickson
11-20-2011, 02:49 AM
Perhaps something like this
Sub test()
Dim sourceRange As Range
Dim destinationRange As Range

Set sourceRange = Worksheets("Monthly Source").Range("C400:C5582")
Set destinationRange = Sheets("Monthly Source").Range("G4:G161")

With sourceRange
destinationRange.Resize(.Rows.Count, .Columns.Count).Value = .Value
End With

On Error Resume Next
destinationRange.SpecialCells(xlCellTypeConstants, xlErrors).ClearContents
On Error GoTo 0
End Sub

jammer6_9
11-20-2011, 05:30 AM
Hi! Its almost there. Yes non error values is copied :thumb as attached. Now what i want to achieve is sourcerange to be copied in destination without blankrows without deleting or hiding any rows in the destination. Should we filter the source range first before copying or we can copy it directly.


Perhaps something like this
Sub test()
Dim sourceRange As Range
Dim destinationRange As Range

Set sourceRange = Worksheets("Monthly Source").Range("C400:C5582")
Set destinationRange = Sheets("Monthly Source").Range("G4:G161")

With sourceRange
destinationRange.Resize(.Rows.Count, .Columns.Count).Value = .Value
End With

On Error Resume Next
destinationRange.SpecialCells(xlCellTypeConstants, xlErrors).ClearContents
On Error GoTo 0
End Sub

mikerickson
11-20-2011, 11:06 AM
How about this
Sub test()
Dim sourceRange As Range
Dim destinationRange As Range
Dim arrTemp As Variant

Set sourceRange = Worksheets("Monthly Source").Range("C400:C5582")
Set destinationRange = Sheets("Monthly Source").Range("G4:G161")
Set sourceRange = Sheet1.Range("A1:A15")
Set destinationRange = Sheet1.Range("Q2")

With sourceRange
Set destinationRange = destinationRange.Resize(.Rows.Count, .Columns.Count)
End With

With destinationRange
.Value = sourceRange.Value
On Error Resume Next
.SpecialCells(xlCellTypeConstants, xlErrors).ClearContents
On Error GoTo ErrorOut

If .Cells(1, 1) = vbNullString Then
With .SpecialCells(xlCellTypeConstants).Areas(1)
arrTemp = .Value
.ClearContents
destinationRange.Resize(.Rows.Count, 1).Value = arrTemp
End With
End If

Do While 1 < .SpecialCells(xlCellTypeConstants).Areas.Count
With .SpecialCells(xlCellTypeConstants).Areas(2)
arrTemp = .Value
.ClearContents
destinationRange.SpecialCells(xlCellTypeBlanks).Cells(1, 1).Resize(.Rows.Count, 1).Value = arrTemp
End With
Loop
End With

ErrorOut:
On Error GoTo 0
End Sub

Paul_Hossler
11-20-2011, 12:28 PM
Hi, thanks for the reply? What about the rArea? Is this the destination cell? Should I set it?

Copy doesn't work with a multi-area range, so the For Each rArea just loops each area for each of the 3 the source ranges (Numbers, Text, and Logical)

It's a local variable so you don't need to set it

I copied and pasted values and formats to the same address on another sheet just as an example

Actuially I like Mike's approach a little better -- copy them all and clear the ones not wanted

Paul

mancubus
11-20-2011, 12:56 PM
this could be an option... (i hope)..

Sub copy_not_error_values_only()

Dim ws As Worksheet
Dim cll As Range, rng As Range
Dim NonErrors()
Dim i As Long

Set ws = Worksheets("Monthly Source")

With ws
If .Range("F2") = "HIGH RISK" Then
.Range("G4:G161").ClearContents
Set rng = .Range("C400:C5582")
ReDim NonErrors(1 To rng.Rows.Count)
For Each cll In rng
If Not IsError(cll.Value) Then
i = i + 1
NonErrors(i) = cll.Value
End If
Next
.Range("G4").Resize(UBound(NonErrors), 1) = Application.Transpose(NonErrors)
End If
End With

End Sub

jammer6_9
11-20-2011, 01:11 PM
Perfect :clap: :cloud9:


this could be an option... (i hope)..

Sub copy_not_error_values_only()

Dim ws As Worksheet
Dim cll As Range, rng As Range
Dim NonErrors()
Dim i As Long

Set ws = Worksheets("Monthly Source")

With ws
If .Range("F2") = "HIGH RISK" Then
.Range("G4:G161").ClearContents
Set rng = .Range("C400:C5582")
ReDim NonErrors(1 To rng.Rows.Count)
For Each cll In rng
If Not IsError(cll.Value) Then
i = i + 1
NonErrors(i) = cll.Value
End If
Next
.Range("G4").Resize(UBound(NonErrors), 1) = Application.Transpose(NonErrors)
End If
End With

End Sub

mancubus
11-20-2011, 02:39 PM
this is a better solution since it fills array with non error and non blank cells...

it clears contents of all cells in in col G starting from G4.


Sub copy_not_error_values_only()

Dim ws As Worksheet
Dim cll As Range, rng As Range
Dim NonErrors()
Dim i As Long

Set ws = Worksheets("Monthly Source")

With ws
If .Range("F2") = "HIGH RISK" Then
.Range("G4:G" & .Cells(.Rows.Count, "G").End(xlUp).Row).ClearContents
Set rng = .Range("C400:C5582")
For Each cll In rng
If Not IsError(cll.Value) Then
If Trim(cll.Value) <> vbNullString Then
ReDim Preserve NonErrors(i)
NonErrors(i) = cll.Value
i = i + 1
End If
End If
Next
.Range("G4").Resize(UBound(NonErrors) + 1, 1) = Application.Transpose(NonErrors)
End If
End With

End Sub

jammer6_9
11-20-2011, 10:22 PM
Thanks a lot :beerchug:


this is a better solution since it fills array with non error and non blank cells...

it clears contents of all cells in in col G starting from G4.


Sub copy_not_error_values_only()

Dim ws As Worksheet
Dim cll As Range, rng As Range
Dim NonErrors()
Dim i As Long

Set ws = Worksheets("Monthly Source")

With ws
If .Range("F2") = "HIGH RISK" Then
.Range("G4:G" & .Cells(.Rows.Count, "G").End(xlUp).Row).ClearContents
Set rng = .Range("C400:C5582")
For Each cll In rng
If Not IsError(cll.Value) Then
If Trim(cll.Value) <> vbNullString Then
ReDim Preserve NonErrors(i)
NonErrors(i) = cll.Value
i = i + 1
End If
End If
Next
.Range("G4").Resize(UBound(NonErrors) + 1, 1) = Application.Transpose(NonErrors)
End If
End With

End Sub