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
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.