Forum Discussion

Khalid0090's avatar
Khalid0090
Copper Contributor
Aug 15, 2023
Solved

VBA Help

Hello All,

 

I'm working on a form created by Excel and I want to insert buttons and give them some functionality using VBA. I tried using Macros but I didn't get the result I wanted. This form will be sent to customers and they will fill in some general information (I didn't mention it in the picture) and after that they will choose from a drop-down list as shown in the attached image and they can write any additional details in the gray merged cells.

 

What I want to do is to use the "Add" button so the highlighted are is copied and pasted again and again under each other with space between them (like two rows) and when the person press the delete button, the last area will be deleted. So the VBA should look for (Let's say the next 500 rows from cell A1, please note the cell reference might change) the last text written in column A (Which will be the "Additional Details") and add these fields after it by 8 rows (This is for adding) and rest the drop-down list to the first value and removing the text from the additional details are. Regarding the delete, the VBA should look for the last text written in column A and delete it (will delete the area entirely like the rows from "Choose an option" till the end of the merged cells of the "Additional Details").

 

I hope my request is clear and I'm sorry for any inconvenience and appreciate your efforts.

 

 

excel
Macros and VBA
  • JKPieterse's avatar
    JKPieterse
    Aug 15, 2023

    Khalid0090 Have a look at the attached.

    The buttons are tied to this code:

     

    
Sub AddItem()
    Dim targetCell As Range
    With ActiveSheet
        Set targetCell = .Range("A" & .Rows.Count).End(xlUp).Offset(9)
        targetCell.Offset(-11).Resize(10).EntireRow.Copy
        targetCell.EntireRow.Insert xlDown
        targetCell.Offset(-10, 2).Value = 1 'Sets dropdown to 1, change accordingly
        targetCell.Offset(-10, 2).Select
        Application.CutCopyMode = False 'Clear clipboard
    End With
End Sub

Sub RemoveItem()
    Dim targetCell As Range
    With ActiveSheet
        Set targetCell = .Range("A" & .Rows.Count).End(xlUp).Offset(9)
        If targetCell.Row > 20 Then
            targetCell.Offset(-11).Resize(10).EntireRow.Delete
        Else
            MsgBox "Cannot delete first entry"
        End If
    End With
End Sub
  • JKPieterse's avatar
    JKPieterse
    Silver Contributor
    Aug 15, 2023

    Khalid0090 Have a look at the attached.

    The buttons are tied to this code:

     

    
Sub AddItem()
    Dim targetCell As Range
    With ActiveSheet
        Set targetCell = .Range("A" & .Rows.Count).End(xlUp).Offset(9)
        targetCell.Offset(-11).Resize(10).EntireRow.Copy
        targetCell.EntireRow.Insert xlDown
        targetCell.Offset(-10, 2).Value = 1 'Sets dropdown to 1, change accordingly
        targetCell.Offset(-10, 2).Select
        Application.CutCopyMode = False 'Clear clipboard
    End With
End Sub

Sub RemoveItem()
    Dim targetCell As Range
    With ActiveSheet
        Set targetCell = .Range("A" & .Rows.Count).End(xlUp).Offset(9)
        If targetCell.Row > 20 Then
            targetCell.Offset(-11).Resize(10).EntireRow.Delete
        Else
            MsgBox "Cannot delete first entry"
        End If
    End With
End Sub
    • Khalid0090's avatar
      Khalid0090
      Copper Contributor
      Aug 15, 2023

      JKPieterse 

      Thank you so much for your response, I really appreciate it. One thing to ask for, is there any way to reset the additional details field as well (Same as the drop-down list) it will be super helpful. And if I want to add another field under the "Choose an option" field, where should I add it in the VBA code? and how

       

      Thank you again.

       

       

      • JKPieterse's avatar
        JKPieterse
        Silver Contributor
        Aug 16, 2023

        Khalid0090 Replace all of the code with this:

        Option Explicit

Const ROWSPERSECTION As Long = 10

Sub AddItem()
    Dim targetCell As Range
    
    With ActiveSheet
        Set targetCell = .Range("A" & .Rows.Count).End(xlUp).Offset(ROWSPERSECTION - 1)
        targetCell.Offset(-ROWSPERSECTION).Resize(ROWSPERSECTION).EntireRow.Copy
        targetCell.EntireRow.Insert xlDown
        targetCell.Offset(-ROWSPERSECTION, 2).Value = 1 'Sets dropdown to 1, change accordingly
        targetCell.Offset(-ROWSPERSECTION + 3, 2).MergeArea.ClearContents 'Clear details box
        targetCell.Offset(-ROWSPERSECTION, 2).Select
        Application.CutCopyMode = False 'Clear clipboard
    End With
End Sub

Sub RemoveItem()
    Dim targetCell As Range
    With ActiveSheet
        Set targetCell = .Range("A" & .Rows.Count).End(xlUp).Offset(ROWSPERSECTION - 1)
        If targetCell.Row > 2 * ROWSPERSECTION Then
            targetCell.Offset(-ROWSPERSECTION - 1).Resize(ROWSPERSECTION).EntireRow.Delete
        Else
            MsgBox "Cannot delete first entry"
        End If
    End With
End Sub

        This allows you to easily change the size of the section that is copied/removed by editing that top constant "ROWSPERSECTION".

        Make sure the two buttons are far enough below the last section to avoid their size to change.

Resources