Consulting

Results 1 to 11 of 11

Thread: Copy Non Error values

  1. #1
    VBAX Mentor jammer6_9's Avatar
    Joined
    Apr 2007
    Location
    Saudi Arabia
    Posts
    318
    Location

    Copy Non Error values

    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?

    [VBA]
    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

    [/VBA]
    T-ogether
    E-veryone
    A-chieves
    M-ore


    One who asks a question is a fool for five minutes; one who does not ask a question remains a fool forever.

  2. #2
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,729
    Location
    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.


    [VBA]
    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("A110").SpecialCells(xlCellTypeFormulas, xlNumbers)
    Set rText = Worksheets("sheet1").Range("A110").SpecialCells(xlCellTypeFormulas, xlTextValues)
    Set rLogical = Worksheets("sheet1").Range("A110").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
    [/VBA]

    Paul

  3. #3
    VBAX Mentor jammer6_9's Avatar
    Joined
    Apr 2007
    Location
    Saudi Arabia
    Posts
    318
    Location
    Hi, thanks for the reply? What about the rArea? Is this the destination cell? Should I set it?
    T-ogether
    E-veryone
    A-chieves
    M-ore


    One who asks a question is a fool for five minutes; one who does not ask a question remains a fool forever.

  4. #4
    Mac Moderator VBAX Guru mikerickson's Avatar
    Joined
    May 2007
    Location
    Davis CA
    Posts
    2,778
    Perhaps something like this
    [VBA]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[/VBA]
    Last edited by mikerickson; 11-20-2011 at 03:10 AM.

  5. #5
    VBAX Mentor jammer6_9's Avatar
    Joined
    Apr 2007
    Location
    Saudi Arabia
    Posts
    318
    Location
    Hi! Its almost there. Yes non error values is copied 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.

    Quote Originally Posted by mikerickson
    Perhaps something like this
    [VBA]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[/VBA]
    Attached Images Attached Images
    T-ogether
    E-veryone
    A-chieves
    M-ore


    One who asks a question is a fool for five minutes; one who does not ask a question remains a fool forever.

  6. #6
    Mac Moderator VBAX Guru mikerickson's Avatar
    Joined
    May 2007
    Location
    Davis CA
    Posts
    2,778
    How about this
    [VBA]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[/VBA]

  7. #7
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,729
    Location
    Quote Originally Posted by jammer6_9
    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

  8. #8
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    this could be an option... (i hope)..

    [VBA]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
    [/VBA]
    PLS DO NOT PM; OPEN A THREAD INSTEAD!!!

    1) Posting Code
    [CODE]PasteYourCodeHere[/CODE]
    (or paste your code, select it, click # button)

    2) Uploading File(s)
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    Replace company specific / sensitive / confidential data. Include so many rows and sheets etc in the uploaded workbook to enable the helpers visualize the data and table structure. Helpers do not need the entire workbook.

    3) Testing the Codes
    always back up your files before testing the codes.

    4) Marking the Thread as Solved
    from Thread Tools (on the top right corner, above the first message)

  9. #9
    VBAX Mentor jammer6_9's Avatar
    Joined
    Apr 2007
    Location
    Saudi Arabia
    Posts
    318
    Location
    Perfect

    Quote Originally Posted by mancubus
    this could be an option... (i hope)..

    [VBA]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
    [/VBA]
    T-ogether
    E-veryone
    A-chieves
    M-ore


    One who asks a question is a fool for five minutes; one who does not ask a question remains a fool forever.

  10. #10
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    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.

    [VBA]
    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

    [/VBA]
    PLS DO NOT PM; OPEN A THREAD INSTEAD!!!

    1) Posting Code
    [CODE]PasteYourCodeHere[/CODE]
    (or paste your code, select it, click # button)

    2) Uploading File(s)
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    Replace company specific / sensitive / confidential data. Include so many rows and sheets etc in the uploaded workbook to enable the helpers visualize the data and table structure. Helpers do not need the entire workbook.

    3) Testing the Codes
    always back up your files before testing the codes.

    4) Marking the Thread as Solved
    from Thread Tools (on the top right corner, above the first message)

  11. #11
    VBAX Mentor jammer6_9's Avatar
    Joined
    Apr 2007
    Location
    Saudi Arabia
    Posts
    318
    Location
    Thanks a lot

    Quote Originally Posted by mancubus
    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.

    [VBA]
    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

    [/VBA]
    T-ogether
    E-veryone
    A-chieves
    M-ore


    One who asks a question is a fool for five minutes; one who does not ask a question remains a fool forever.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •