SOLVED

VBA Help

Copper Contributor

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.

 

Khalid0090_3-1692112685681.png

 

3 Replies
best response confirmed by Khalid0090 (Copper Contributor)
Solution

@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

@Jan Karel Pieterse 

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.

Khalid0090_0-1692134433048.png

 

 

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

1 best response

Accepted Solutions
best response confirmed by Khalid0090 (Copper Contributor)
Solution

@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

View solution in original post