-1

I have been struggling with an excel problem for a few days now. My Excel workbook has two sheets titled 'Sheet1' and 'Sheet2'.

The headers in both workbooks are identical and range from A2:M2.

What I am looking to achieve through vba is to introduce a button at the end of each row N3, N4 etc. that will remove the row and paste it into the 'Sheet2' next available row. I would need max 100 buttons in Rows N3:N102. If macro button N10 (for example) is selected, it would copy the contents A10:M10 from 'Sheet1' into the next available row (after A2:M2) in 'Sheet2'. And also remove the line A:10:M10 from 'Sheet1'. while maintaining the 100 Buttons...

Does this make sense as to what I am trying to achieve? all coding I have searched to date does not include the button functionality.

Thanks for your help and time.

ConorCK
  • 11
  • 3
  • You're probably not going to get someone to write the code for you. Have you tried manually adding these buttons and using the macro recorder to get started? Try getting some example code that gets you closer and posting it here with specific questions. – TheEngineer Feb 12 '15 at 14:35
  • Thanks I have some codes I have tried yes, which work. I will post them shortly. the issue I have is the deletion of the rows but to retain the button at the side. – ConorCK Feb 12 '15 at 15:01

3 Answers3

1

If I'm understanding right here you go. The first sub is taken from belisarius and adapted to fill in every row from 2 to 100 then I'm assigning a macro called myMacro to every button.

Sub addButton()
Dim btn As Button
Application.ScreenUpdating = False
ActiveSheet.Buttons.Delete
Dim t As Range


For i = 2 To 100 Step 1
   Set t = ActiveSheet.Range(Cells(i, 14), Cells(i, 14))
   Set btn = ActiveSheet.Buttons.Add(t.Left, t.Top, t.Width, t.Height)
   With btn
     .OnAction = "btnS"
     .Caption = "Btn " & i
     .Name = i
     .OnAction = "myMacro"
   End With
Next i

Application.ScreenUpdating = True

End Sub

You can run this as many times as you like as it will just clear and remake the 99 (red - couldn't resist, not actually red) buttons.


Sub myMacro()
Dim sheet1, sheet2 As Worksheet
Dim ButtonName As Integer
Dim checkBlankRange As Range
Dim answerRange As Range
Dim pasteRow As Integer

Set sheet1 = ActiveWorkbook.Sheets("Sheet1")
Set sheet2 = ActiveWorkbook.Sheets("sheet2")
Set checkBlankRange = sheet2.Range("A:A")

ButtonName = Application.Caller

Set answerRange = sheet1.Range("a" & ButtonName & ":m" & ButtonName)


        For Each cell In checkBlankRange
            If cell.Value = "" Then 'first empty cell
                    pasteRow = cell.row 'get the row number of the empty cell
                    sheet2.Range("a" & pasteRow & ":m" & pasteRow).Value2 = answerRange.Value2
                Exit For
            End If
        Next cell

answerRange.Delete Shift:=xlUp

End Sub

the second part gets the button name we set in the first macro on sheet1 and assigns to the first empty row on sheet2 based on the "A:A" range. Finally it deletes the range on sheet1 corresponding to the button you selected.

Community
  • 1
  • 1
jamesC
  • 422
  • 6
  • 25
1

Here is an alternate version:

Sub CreateButtons()

    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim NCell As Range
    Dim i As Long

    Set ws1 = ActiveWorkbook.Sheets("Sheet1")
    Set ws2 = ActiveWorkbook.Sheets("Sheet2")

    ws1.Buttons.Delete

    For Each NCell In ws1.Range("N3:N102").Cells
        i = i + 1
        With ws1.Buttons.Add(NCell.Left, NCell.Top, NCell.Width, NCell.Height)
            .Name = "btn_MoveRow_" & Format(i, "00#")
            .Characters.Text = "Move Row"
            .OnAction = "MoveRow"
        End With
    Next NCell

End Sub

And the MoveRow subroutine assigned to the buttons:

Sub MoveRow()

    Dim ws1 As Worksheet
    Dim ws2 As Worksheet

    Set ws1 = ActiveWorkbook.ActiveSheet
    Set ws2 = ActiveWorkbook.Sheets("Sheet2")

    With Intersect(ws1.Range("A:M"), ws1.Buttons(Application.Caller).TopLeftCell.EntireRow)
        ws2.Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(, .Columns.Count).Value = .Value
        .Delete xlShiftUp
    End With

End Sub
tigeravatar
  • 26,199
  • 5
  • 30
  • 38
0

JamesC and tigeravatar,

thanks a lot for your time and effort, the codes work perfectly for what I was trying to do.

I managed to get the buttons to create but couldn't get the move and copy to work for me. but both your solutions are perfect for what I was trying to do.

Thanks again!!

ConorCK
  • 11
  • 3