excelvbacopypastewith-statement

Is there a way to check if each of many non-contiguous cells is empty?


I have code which pastes data from one spreadsheet to another.

The spreadsheet I'm pulling the data from either has data, or 'NR' in the cell.

I set it up so that any pasted 'NR' will be removed.

I need to:

  1. not copy 'NR' or
  2. not paste over data that is already in the cell

This code runs every day, and there will be data only on one day per month, which needs to remain in the destination spreadsheet. I don't want it being overwritten by 'NR'.

Here is an example of what I have. This overwrites legitimate data with 'NR', then removes the 'NR' leaving the cell blank.
Note: the cells I am pasting to are non-contiguous, and this is a small sample.

I was thinking I need something like a with wsElog2 if the cell is empty then copy otherwise go to next range'. I don't know how to do this for the semi random cells I have.

wsElog2.Range("E60") = wseDNA2.Range("DE15") 'Filtered Effluent Calcium
wsElog2.Range("E61") = wseDNA2.Range("DO15") 'Filtered Effluent Magnesium
wsElog2.Range("E64") = wseDNA2.Range("EA15") 'Filtered Effluent Potassium
wsElog2.Range("E62") = wseDNA2.Range("EE15") 'Filtered Effluent Sodium


'Lagoons 1
wsElog2.Range("G55") = wseDNA2.Range("EU15") 'Ammonia
wsElog2.Range("G48") = wseDNA2.Range("EW15") 'Blue Green Algae
wsElog2.Range("G52") = wseDNA2.Range("EY15") 'E. coli
wsElog2.Range("G59") = wseDNA2.Range("FA15") 'EC
wsElog2.Range("G54") = wseDNA2.Range("FC15") 'Nitrate
wsElog2.Range("G53") = wseDNA2.Range("FE15") 'Nitrite
wsElog2.Range("G57") = wseDNA2.Range("FG15") 'TN
wsElog2.Range("G58") = wseDNA2.Range("FI15") 'pH
wsElog2.Range("G56") = wseDNA2.Range("FK15") 'TP

For Each c In wsElog2.Range("B1:L159")
    If c.Text = "NR" Then
        c.Value = ""
    End If
Next

This was solved with the answer provided, with a couple of small alterations to the code as below:
(Note: I didn't get the DEBUG.PRINT sections working. I got rid of them.)

Sub CopyCellValues()
    
    ' Monitor the behavior in the Immediate window (Ctrl+G), or not.
    Const DEBUG_PRINT As Boolean = True
    
    ' Write the cell addresses to arrays.
    Dim SourceCells() As Variant: SourceCells = Array("DO15", "EA15", "EE15")
    Dim TargetCells() As Variant: TargetCells = Array("E61", "E64", "E62")
    
    ' Existing code that e.g. sets the worksheets, ...
    
    Dim sVal As Variant, n As Long, IsSourceValid As Boolean
    
    For n = LBound(SourceCells) To UBound(SourceCells)
        With wsElog2.Range(TargetCells(n, 1))
            ' Check target.
            If Len(CStr(.Value)) = 0 Then ' blank
                ' Check source.
                sVal = wseDNA2.Range(SourceCells(n, 1)).Value ' store in variable
                If Not IsError(sVal) Then ' not an error value
                    If Len(sVal) > 0 Then ' not blank
                        If StrComp(sVal, "NR", vbTextCompare) <> 0 Then ' not equal
                            IsSourceValid = True
                        End If
                    End If
                End If
            End If
            If IsSourceValid = True Then
                ' Write.
                .Value = sVal
                ' Reset.
                IsSourceValid = False
                If DEBUG_PRINT = True Then Debug.Print "Copying """ & CStr(sVal) _
                    & """ from """ & wseDNA2.Name & "!" & SourceCells(n) _
                    & """ to """ & .Worksheet.Name & "!" & .Address(0, 0) & """!"
            Else
                If DEBUG_PRINT = true Then Debug.Print "Not copying """ & CStr(sVal) _
                    & """ from """ & wseDNA2.Name & "!" & SourceCells(n) _
                    & """ to """ & .Worksheet.Name & "!" & .Address(0, 0) & """!"
            End If
        End With
    Next n

End Sub

Solution

  • Copy Cell Values

    Sub CopyCellValues()
        
        ' Monitor the behavior in the Immediate window (Ctrl+G), or not.
        Const DEBUG_PRINT As Boolean = True
        
        ' Write the cell addresses to arrays.
        Dim SourceCells() As Variant: SourceCells = Array("DO15", "EA15", "EE15")
        Dim TargetCells() As Variant: TargetCells = Array("E61", "E64", "E62")
        
        ' Existing code that e.g. sets the worksheets, ...
        
        Dim sVal As Variant, n As Long, IsSourceValid As Boolean
        
        For n = LBound(SourceCells) To UBound(SourceCells)
            With wsElog2.Range(TargetCells(n))
                ' Check target.
                If Len(CStr(.Value)) = 0 Then ' blank
                    ' Check source.
                    sVal = wseDNA2.Range(SourceCells(n)).Value ' store in variable
                    If Not IsError(sVal) Then ' not an error value
                        If Len(sVal) > 0 Then ' not blank
                            If StrComp(sVal, "NR", vbTextCompare) <> 0 Then ' not equal
                                IsSourceValid = True
                            End If
                        End If
                    End If
                End If
                If IsSourceValid Then
                    ' Write.
                    .Value = sVal
                    ' Reset.
                    IsSourceValid = False
                    If DEBUG_PRINT Then Debug.Print "Copying """ & CStr(sVal) _
                        & """ from """ & wseDNA2.Name & "!" & SourceCells(n) _
                        & """ to """ & .Worksheet.Name & "!" & .Address(0, 0) & """!"
                Else
                    If DEBUG_PRINT Then Debug.Print "Not copying """ & CStr(sVal) _
                        & """ from """ & wseDNA2.Name & "!" & SourceCells(n) _
                        & """ to """ & .Worksheet.Name & "!" & .Address(0, 0) & """!"
                End If
            End With
        Next n
    
    End Sub