VBA copy/paste only if cells are empty

[inetquestion]

I have a spreadsheet as shown below. VBA code was inserted so the double clicking on the cells in Colomn A where the months are listed would take the values in ROW1 and copy them to the row you clicked on. What modifications should be made so that this copy/paste would only occur if the destination cells were empty. Giving the user the option to clear them with a dialog box, or telling which cells were not empty would be nice, but not necessary. The VBA code to perform the copy/paste follows:

TIA,

-Inet



0 | 100 250 500 300 4525
--------------------------------------------
Jan| 100 250 500 300 4525
FEB| 100 250 500 300 4525
MAR| 100 250 500 300 4525
APR| 100 250 500 300 4525
MAY| 100 250 500 300 4525


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
Dim C As Range
Set C = Intersect(Target.Cells(1, 1), Range("A2:A100"))
If Not C Is Nothing Then

Range("B1:Z1").Copy
C.Offset(0, 1).PasteSpecial (xlPasteValues)
Application.CutCopyMode = False

Range("AC1").Copy
C.Offset(0, 28).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False


End If
Cancel = True ' cancels default double-click behavior
End Sub

 

[byundt]

Inet,
I'm not sure if you want to avoid putting any values in the row if it already contains data--or if you just don't want to overwrite existing data. Both options are coded in this revision to your sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
Dim C As Range, cel As Range, rg As Range
Dim intOverwrite As Integer
Set C = Intersect(Target.Cells(1, 1), Range("A2:A100"))
If Not C Is Nothing Then

    Set rg = Range(C.Offset(0, 1), C.Offset(0, 25))
    If Application.CountA(rg) = 0 Then
        rg.Value = Range("B1:Z1").Value
        C.Offset(0, 28) = Range("AC1")
    Else
        intOverwrite = MsgBox("There's data already in this row. Would you like to overwrite it?", vbYesNo)
        If intOverwrite = vbYes Then
            rg.Value = Range("B1:Z1").Value
            C.Offset(0, 28) = Range("AC1")
        Else
            
        'The next four lines paste data only if the receiving cell was originally blank
            For Each cel In rg
                If Not cel.HasFormula Then cel = Cells(1, cel.Column)
            Next cel
            If Not C.Offset(0, 28).HasFormula Then C.Offset(0, 28) = Range("AC1")
        End If
    End If
      
End If
Cancel = True ' cancels default double-click behavior
End Sub

Brad