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:
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
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