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