Only copy if cell has data

[edwardpestian]

I'm new to VBA, and I've managed to create a button in an excel spreadsheet. The button, when clicked, takes a range of data in one sheet, and copies the values to a range in another sheet. My problem is that if the original cells do not contain data, and I press the button, it will overwrite data in the destination cells. Is there a VBA command that can tell excel only to copy the values to the destination cells if they are not and empty cell?

Thanks in advance.

EP

 

[PHV]

Have a look at the PasteSpecial method.

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[edwardpestian]

Sorry, I don't see which method you are referring to.

EP

 

[PHV]

Why not posting your actual code ?

 

[PHV]

I don't see which method you are referring to
When in VBE (Ctr+G) feel free to play with the F2 and F1 keys ...

 

[edwardpestian]

Here's the code. I changed the SkipBlanks:= _
False to True, which solved my original problem. However, I still have a long way to go. My intent is to have this button copy the values of the cells in the original range to a cell range in another sheet based on a Date and Shift criteria selected in the sheet containing the button.

Thanks again.

EP

Sub Button1_Click()
'
' Button1_Click Macro
' Macro recorded 4/28/2006 by Edward Pestian
'

'

If Sheets("Data").Range("Y3") = Sheets("Input").Range("G9") = True Then

Range("G15:H29").Select
Selection.Copy
Sheets("Data").Select
Range("D114").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
True, Transpose:=False
Sheets("Input").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("L15:M24").Select
Selection.Copy
Sheets("Data").Select
Range("D130").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("D114").Select
Sheets("Input").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("G15").Select

End If
If Range("C15") = Range("F15") = False Then

Answer = MsgBox("These dates have already been entered. Do you want to continue?", vbYesNo)

End If

If Answer = vbYes Then

Range("G15:H29").Select
Selection.Copy
Sheets("Data").Select
Range("D114").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
True, Transpose:=False
Sheets("Input").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("L15:M24").Select
Selection.Copy
Sheets("Data").Select
Range("D130").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("D114").Select
Sheets("Input").Select
Selection.ClearContents
Range("G15").Select
Application.CutCopyMode = False


ElseIf Answer = vbNo Then
'Do Nothing

End If


End Sub

 

[firefytr]

You could probably shorten that to ...


Sub Button1_Click()
Dim Answer As VbMsgBoxResult
Dim blnCopy As Boolean
If Sheets("Data").Range("Y3").Value = Sheets("Input").Range("G9").Value Then
CopyData:
Sheets("Input").Range("G15:H29").Copy
Sheets("Data").Range("D114").PasteSpecial Paste:=xlValues, SkipBlanks:=True
Sheets("Input").Range("G15:H29").ClearContents
Sheets("Input").Range("L15:M24").Copy
Sheets("Data").Range("D130").PasteSpecial Paste:=xlValues
Sheets("Input").Range("L15:M24").ClearContents
If blnCopy = True Then GoTo ResumeHere
blnCopy = True
End If
If Range("C15").Value <> Range("F15").Value = False Then
Answer = MsgBox("These dates have already been entered. Do you want to continue?", vbYesNo)
End If
If Answer = vbYes Then
GoTo CopyData
ResumeHere:
ElseIf Answer = vbNo Then
'Do Nothing
End If
Continue:
Application.CutCopyMode = False
End Sub


Is this what you're looking for??

-----------
Regards,
Zack Barresse

 

[edwardpestian]

Yes, it seems to work as I want. I am still working on another aspect that I'm really not where to start. I need the above code to copy the values to specific cells based on two criteria:

First, the Shift, which is a list box containing "Day" "Swing" "Grave"
Secondly date: which is a reference to a date in a specific cell.

The code should then lookup the column contianing the date, find the column below the date containing the shift, and then paste the values. Right now I'm using an offset formula to find this info, but I need code to actually past the data from the other worksheet into these cells.

Any ideas?

I could send you the workbook if that would help any.

Thanks again for your help.

EP

 

[firefytr]

You'll either need to explain in greater detail your data structure or email me the workbook, because I don't really understand how your workbook is structured at the moment. If you want to email, my addy is firefytr AT vbaexpress DOT com. If we can keep it on the board, let's do that, otherwise we can use the email.

-----------
Regards,
Zack Barresse

 

[edwardpestian]

I'm getting a syntax error on the code above.

The following lines are showing up red:

Dim Answer As VbMsgBoxResult
    Dim blnCopy As Boolean
    If Sheets("Data").Range("Y3").Value = Sheets("Input").Range("G9").Value Then
CopyData:
If blnCopy = True Then GoTo ResumeHere
End If
    If Range("C15").Value <> Range("F15").Value = False Then
End If
    If Answer = vbYes Then
ElseIf Answer = vbNo Then
         'Do Nothing
    End If

Thanks.

EP

 

[firefytr]

Which lines are showing up red? And do you mean yellow? If red, does it go away if you select that line and press F9? If so that is a breakpoint.

-----------
Regards,
Zack Barresse

 

[edwardpestian]

It is saying Compile Error: Automation type not supported in Visual Basic, and highlighting the first line of code.

Dim Answer As VbMsgBoxResult

Any ideas?

EP

 

[firefytr]

Ah, that makes a little more sense. It's not compiling, which means it's not even getting to run *any* of the code yet (it compiles it first, like a pre-run or warm up, checking different parts of the code and it's structure/references).

Maybe you could try this instead ...


Sub Button1_Click()
Dim Answer As VbMsgBoxResult
Dim blnCopy As Boolean
If Sheets("Data").Range("Y3").Value = Sheets("Input").Range("G9").Value Then
CopyData:
Sheets("Input").Range("G15:H29").Copy
Sheets("Data").Range("D114").PasteSpecial Paste:=xlValues, SkipBlanks:=True
Sheets("Input").Range("G15:H29").ClearContents
Sheets("Input").Range("L15:M24").Copy
Sheets("Data").Range("D130").PasteSpecial Paste:=xlValues
Sheets("Input").Range("L15:M24").ClearContents
If blnCopy = True Then GoTo ResumeHere
blnCopy = True
End If
If Range("C15").Value <> Range("F15").Value = False Then
If MsgBox("These dates have already been entered. Do you want to continue?", vbYesNo) = vbYes Then
GoTo CopyData
ResumeHere:
ElseIf Answer = vbNo Then
'Do Nothing
End If
End If
Continue:
Application.CutCopyMode = False
End Sub

-----------
Regards,
Zack Barresse

 

[firefytr]

Okay, with a slightly rearranged input sheet, this code should work for you and be a little more dynamic ...




Sub Button1_Click()

Dim wsInput As Worksheet, wsData As Worksheet
Dim rngDate As Range, rngShift As Range
Dim rngLookConc As Range, rngLookDate As Range
Dim rngFind As Range, rngLoop As Range, c As Range, rngCol As Range
Dim strSearch As String, LastRow As Long
Dim i As Long, Cnt As Long, blnHide As Boolean
Set wsInput = ThisWorkbook.Sheets("Input")
Set wsData = ThisWorkbook.Sheets("Data")
Set rngLookDate = wsData.Range("3:3")
Set rngLookConc = wsData.Range("E:E")
Set rngLookNum = wsData.Range("C:C")
Set rngDate = wsInput.Range("G9")
Set rngShift = wsInput.Range("H9")

Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False

Set rngCol = rngLookDate.Find(rngDate.Value, LookIn:=xlValues, lookat:=xlWhole)
If rngCol Is Nothing Then
MsgBox "That date is not found on the Data sheet!", vbExclamation, "ERROR!"
GoTo EndHere
End If
LastRow = wsInput.Range("G:H").Find("*", after:=wsInput.Range("G1"), searchorder:=xlByRows, searchdirection:=xlPrevious).Row
If LastRow < 15 Then
MsgBox "You have not entered any data in the Drop/Win table!", vbExclamation, "ERROR!"
GoTo EndHere
End If
Set rngLoop = wsInput.Range("F15", wsInput.Cells(wsInput.Rows.Count, 6).End(xlUp))
Cnt = 0
blnHide = rngLookConc.EntireColumn.Hidden
rngLookConc.EntireColumn.Hidden = False
For Each c In rngLoop
strSearch = c.Value & rngShift.Value
Set rngFind = rngLookConc.Find(strSearch, MatchCase:=True)
If Not rngFind Is Nothing Then
If Len(c.Offset(0, 1).Value) = 0 Or Len(c.Offset(0, 2).Value) = 0 Then GoTo SkipCode
wsData.Cells(rngFind.Row, rngCol.Column).Value = c.Offset(0, 1).Value
wsData.Cells(rngFind.Row, rngCol.Column + 1).Value = c.Offset(0, 2).Value
wsData.Cells(rngFind.Row, rngCol.Column + 2).FormulaR1C1 = "=RC[-2]-RC[-1]"
Cnt = Cnt + 1
Set rngFind = Nothing
End If
SkipCode:
Next c
If blnHide Then rngLookConc.EntireColumn.Hidden = True

If Cnt <> 0 Then
MsgBox "A total of " & Cnt & " record(s) have been updated!", vbInformation, "Complete!"
Else
MsgBox "No values were updated!", vbInformation, "Complete!"
End If

EndHere:

Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True

Set rngDate = Nothing
Set rngShift = Nothing
Set rngLookConc = Nothing
Set rngLookDate = Nothing
Set rngFind = Nothing
Set c = Nothing
Set rngCol = Nothing
Set wsData = Nothing
Set wsInput = Nothing

End Sub




The changes include these small items:

On the Data sheet:
1. In columns B & C, there should be no blank rows, meaning everywhere you see a blank row it needs to equal the row above it. Just set the font to match the background color if you want.
And easy way to do this:
Select the entire range of data in B:C (B5:C108), press F5 | Special .. | Blanks, type = and then hit your Up Arrow, confirm with Ctrl + Enter. If you want to have these values static, select the column, copy it, then PasteSpecial/Values.

2. In column D, change your Swg and Gyd to Swing and Grave, just as you have it on your input sheet. You can do a Find/Replace to do this.

3. Insert a new column just after D, it will be your new column E. Starting in Row 5, enter this formula:
=B5&C5&D5
Copy down as far as the column (D) goes. (An easy way to do this is to select the cell, hover your mouse over the bottom right corner of the cell {your mouse icon will turn to a bold + sign} and double click. It is your choice to leave the value or formula in there, I would recommend formula so you don't have to remember it later. It is your choice to leave the column hidden or not, but the code will leave it in the last state it was in; IOW if the column was hidden, it will leave it that way, if it was not, the code will not hide it upon completion.

On the Input sheet:
1. Unmerge those merged cells, it plays hell trying to code for them. Your date cell should be in G9 and your Shift cell should be in H9.

2. Do not put any other data in columns G & H other than your Code/Drop/Win values.


That should be about it. Let us know if this works for you.

-----------
Regards,
Zack Barresse