How to Copy a cell's range into the value of another cell

Question

I am writing a code that goes through a given range of cells with a for each loop. if theses calls do not satisfy an if statement withing the "for each", i need to write the range of that cell on another sheet. Ex: cells A20 and A36 do not conform so I want to write A20 and36 on another sheet. this way i will have a list of all the cells that require attention.Here is my code below:

    r = 5
    Set sht1 = Sheets("DataSheet")
    Set sht2 = Sheets("DiscrepancyReport")
On Error GoTo DiscrepancySheetError
    sht2.Select
On Error GoTo DataSheetError
    sht1.Select
On Error GoTo 0

        lastr = ActiveSheet.range("A1").Offset(ActiveSheet.Rows.Count - 1, 0).End(xlUp).Row
        lastr = lastr - 1

'Column 1: WP
        Set colrg = range("A3:A" & lastr)
            For Each cell In colrg
                If (cell.Value) = 6.01 Or (cell.Value) = 6.03 Or (cell.Value) = 3.04 Or (cell.Value) = 6.27 Then
                Else
                    '## The following line makes no sense but i wrote it so you understand what i want to do
                    currentcell.range.Copy Destination:=sht2.range("A" & r)
                    ActiveCell.Offset(0, 1).Select
                        ActiveCell.Value = "Not a valid WP"
                    r = r + 1
                End If
            Next

Thanks ahead!

if all you are searching for is a way to identify cells with certain values why not use conditional formatting? — chancea, Jul 16 '13 at 19:22
no i have many checks to do. it will get more complicated. this is why i need a sheet to list out all the cells that have errors. — user2385809, Jul 16 '13 at 19:28
fair enough, personally no matter how many checks needed I always use conditional formatting, but to each his own, good luck to you I think Santosh has you covered — chancea, Jul 16 '13 at 19:33

score 1 · Accepted Answer · answered Jul 16 '13 at 19:35

I'm assuming you wanted to put "Not a valid WP" into the DataSheet, and there is no need to use Copy:

Sub CollectRanges()
    r = 5
    Set sht1 = Sheets("DataSheet")
    Set sht2 = Sheets("DiscrepancyReport")
'On Error GoTo DiscrepancySheetError
    sht2.Select
'On Error GoTo DataSheetError
    sht1.Select
On Error GoTo 0

        lastr = ActiveSheet.Range("A1").Offset(ActiveSheet.Rows.Count - 1, 0).End(xlUp).Row
        lastr = lastr - 1

'Column 1: WP
        Set colrg = Range("A3:A" & lastr)
            For Each cell In colrg
                If (cell.Value) = 6.01 Or (cell.Value) = 6.03 Or (cell.Value) = 3.04 Or (cell.Value) = 6.27 Then
                Else
                    sht2.Cells(r, 1).Value = cell.Address
                    cell.Offset(0, 1).Value = "Not a valid WP"
                    r = r + 1
                End If
            Next
End Sub

ah yes this is it. cell.address. Thanks! – user2385809 Jul 17 '13 at 14:52 — user2385809, Jul 17 '13 at 14:52

score 0 · Answer 2 · edited May 23 '17 at 12:21

Here is the updated code assuming your data starts from 3rd row.
Avoid using Select / Activate in the code. Refer this link

Sub test()

    Dim sht1 As Worksheet
    Dim sht2 As Worksheet
    Dim r As Long, lastr As Long

    r = 3
    Set sht1 = Sheets("DataSheet")
    Set sht2 = Sheets("DiscrepancyReport")

    With sht1
        lastr = .Range("A" & .Rows.Count).End(xlUp).Row
        If lastr < 3 Then lastr = 3

        Set colrg = Range("A3:A" & lastr)
    End With


    For Each cell In colrg
        If (cell.Value) = 6.01 Or (cell.Value) = 6.03 Or (cell.Value) = 3.04 Or (cell.Value) = 6.27 Then
        Else
            '## The following line makes no sense but i wrote it so you understand what i want to do
            cell.Copy Destination:=sht2.Range("A" & r)
            sht2.Range("B" & r) = "Not a valid WP"
            r = r + 1
        End If
    Next


End Sub

no this is not it. your code simply coies the content of the cell. I need it to write the range of that cell. ex:A53, not whatever is in A53. — user2385809, Jul 16 '13 at 20:16

Bharath Raja · Answer 3 · 2013-07-17T10:17:25.613

Here is an updated code of Andy's and Santosh's code -

Sub test()

Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim r As Long, lastr As Long

r = 3
Set sht1 = Sheets("DataSheet")
Set sht2 = Sheets("DiscrepancyReport")

With sht1
    lastr = .Range("A" & .Rows.Count).End(xlUp).Row
    If lastr < 3 Then lastr = 3

    Set colrg = Range("A3:A" & lastr)
End With


For Each cell In colrg
    If (cell.Value) <> 6.01 Or (cell.Value) <> 6.03 Or (cell.Value) <> 3.04 Or (cell.Value) <> 6.27 Then
       '## The following line makes no sense but i wrote it so you understand what i want to do
        sht2.Range("A" & r).value=Replace(cell.Address, "$", "")

        'Comment the appropriate one below

        'If you want this to be written in the 2nd sheet, below is the code, else comment it.
        sht2.Range("B" & r) = "Not a valid WP"

        'If you want this to be written in the 1st sheet, below is the code, else comment it.
        cell.offset(0,1).value = "Not a valid WP"
        r = r + 1
    End If
Next

End Sub

Hope this helps.

How to Copy a cell's range into the value of another cell

3 Answers3