Macro to Add Row and Copy/Paste Merged Cells

D

dipitududa2

Hello,

I need some coding guidance for VBA that will does the following:

1. User clicks on a cmdBtn to add a row / cmdBtn to delete a row to/from a
worksheet;
2. The code unprotects the ws, inserts the row and copies the formatting of
the cell; then protects the ws after each iteration.

The problem that I'm having is that some of the cells in the 'copy from' row
are merged and they do not retain the 'merged' properties once 'pasted to'
the new row.

Q: How do I force the new row to retain the 'merge' properties from the
original row?

Here is my code, and thank you for any assistance you can provide me for
this project:

Private Sub cmdAddRow_Click()

On Error GoTo Err_cmdAddRow_Click

Dim rowcount As Integer
'check the cell position
rowcount = Range("U1").FormulaR1C1
If Selection.Offset(-rowcount, 0).FormulaR1C1 = "Invoice Date" Then
Selection.Offset(1, 0).Select
Else
MsgBox "Please click on the last white line under the Invoice Date
column."
Exit Sub
End If
'insert a new row
Selection.EntireRow.Insert
Selection.Offset(0, 12).Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-3]:RC[-2])"
Selection.Offset(0, -12).Select
'initialize counter for deleting row
Dim counter As Integer
counter = Range("U1").FormulaR1C1
Range("U1").FormulaR1C1 = counter + 1
'protect the ws
Call ProtectSheets

Exit_cmdAddRow_Click:
Exit Sub

Err_cmdAddRow_Click:
If Err = 1004 Then
'don't display the cancelled action message
MsgBox "Please click on the last white line under the Invoice Date
column."
Else
MsgBox "#" & Err & " " & Error$
End If
Resume Exit_cmdAddRow_Click

End Sub

Private Sub cmdDeleteRow_Click()

On Error GoTo Err_cmdDeleteRow_Click

'check the cell position
ActiveCell.Select
ra = ActiveCell.Row
RC = ActiveCell.Column
wc = Cells.Find("Invoice Date").Row
ws = Cells.Find("Service Start Date").Row

If ra > wc _
And ra < ws _
And RC = 3 Then
If Selection.FormulaR1C1 = "Invoice Date" Then
Exit Sub
Else
'clear cell contents
If Selection.Offset(-1, 0).FormulaR1C1 = "Invoice Date" Then
Range(Selection, Selection.Offset(0, 12)).Select
Selection.ClearContents
Exit Sub
Else
'delete the row
Selection.EntireRow.Delete
Dim counter As Integer
counter = Range("U1").FormulaR1C1
Range("U1").FormulaR1C1 = counter - 1
End If
End If
'protect the ws
Call ProtectSheets
Else
MsgBox "Please use appropriate Delete button for the budget category you
are working with on the form."
End If

Exit_cmdDeleteRow_Click:
Exit Sub

Err_cmdDeleteRow_Click:
If Err = 1004 Then
'don't display the cancelled action message
MsgBox "Please use appropriate Delete button for the budget category you
are working with on the form."
Else
MsgBox "#" & Err & " " & Error$
End If
Resume Exit_cmdDeleteRow_Click

End Sub
 
D

dipitududa2

dipitududa2 said:
Hello,

I need some coding guidance for VBA that will does the following:

1. User clicks on a cmdBtn to add a row / cmdBtn to delete a row to/from a
worksheet;
2. The code unprotects the ws, inserts the row and copies the formatting of
the cell; then protects the ws after each iteration.

The problem that I'm having is that some of the cells in the 'copy from' row
are merged and they do not retain the 'merged' properties once 'pasted to'
the new row.

Q: How do I force the new row to retain the 'merge' properties from the
original row?

Here is my code, and thank you for any assistance you can provide me for
this project:

Private Sub cmdAddRow_Click()

On Error GoTo Err_cmdAddRow_Click

Dim rowcount As Integer
'check the cell position
rowcount = Range("U1").FormulaR1C1
If Selection.Offset(-rowcount, 0).FormulaR1C1 = "Invoice Date" Then
Selection.Offset(1, 0).Select
Else
MsgBox "Please click on the last white line under the Invoice Date
column."
Exit Sub
End If
'insert a new row
Selection.EntireRow.Insert
Selection.Offset(0, 12).Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-3]:RC[-2])"
Selection.Offset(0, -12).Select
'initialize counter for deleting row
Dim counter As Integer
counter = Range("U1").FormulaR1C1
Range("U1").FormulaR1C1 = counter + 1
'protect the ws
Call ProtectSheets

Exit_cmdAddRow_Click:
Exit Sub

Err_cmdAddRow_Click:
If Err = 1004 Then
'don't display the cancelled action message
MsgBox "Please click on the last white line under the Invoice Date
column."
Else
MsgBox "#" & Err & " " & Error$
End If
Resume Exit_cmdAddRow_Click

End Sub

Private Sub cmdDeleteRow_Click()

On Error GoTo Err_cmdDeleteRow_Click

'check the cell position
ActiveCell.Select
ra = ActiveCell.Row
RC = ActiveCell.Column
wc = Cells.Find("Invoice Date").Row
ws = Cells.Find("Service Start Date").Row

If ra > wc _
And ra < ws _
And RC = 3 Then
If Selection.FormulaR1C1 = "Invoice Date" Then
Exit Sub
Else
'clear cell contents
If Selection.Offset(-1, 0).FormulaR1C1 = "Invoice Date" Then
Range(Selection, Selection.Offset(0, 12)).Select
Selection.ClearContents
Exit Sub
Else
'delete the row
Selection.EntireRow.Delete
Dim counter As Integer
counter = Range("U1").FormulaR1C1
Range("U1").FormulaR1C1 = counter - 1
End If
End If
'protect the ws
Call ProtectSheets
Else
MsgBox "Please use appropriate Delete button for the budget category you
are working with on the form."
End If

Exit_cmdDeleteRow_Click:
Exit Sub

Err_cmdDeleteRow_Click:
If Err = 1004 Then
'don't display the cancelled action message
MsgBox "Please use appropriate Delete button for the budget category you
are working with on the form."
Else
MsgBox "#" & Err & " " & Error$
End If
Resume Exit_cmdDeleteRow_Click

End Sub

Addendum: I posted this question to the newsgroup yesterday, but have not
received any replies. Am I missing something here? I noticed that all other
posts have been responded to on this site.

I did read the other posts from the MVPs that strongly suggest not trying to
merge cells using code on a macro in VB. I can provide the Excel file that
I'm working on via email to anyone that would like to look at the interface.

Please help!

Heather
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top