+ Reply to Thread
Results 1 to 2 of 2

Macro to Add Row and Copy/Paste Merged Cells

  1. #1
    dipitududa2
    Guest

    Macro to Add Row and Copy/Paste Merged Cells

    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

  2. #2
    dipitududa2
    Guest

    RE: Macro to Add Row and Copy/Paste Merged Cells



    "dipitududa2" wrote:

    > 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

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1