Multiple Command Buttons on one Excel sheet

Question

I have the project in excel with transferring data. It is necessary to allow the run of each individually.

Sheet1 is basic with empty table. Sheet2 is the list of 20+ Command Buttons. And have 20+ sheets with data which is transferring to Sheet1 in table, by clicking on 20+ Command Buttons (from Sheet2). Therefore, each command button refers to a separate sheet of those 20+.

https://i.stack.imgur.com/NdXyz.jpg

This is the Command Button which runs command Insert Rows. All rows go to basic table (Sheet1) recognising the number from first column.

Private Sub CommandButton1_Click()
Dim lastrowOS, lastrowPrekovremeno As Long
Dim skip As Boolean
Dim list As New Collection

lastrowOS = Sheets("OS").Cells(Rows.Count, 1).End(xlUp).Row
lastrowPrekovremeno = Sheets("Prekovremeno").Cells(Rows.Count, 1).End(xlUp).Row

Sheets("OS").Cells(1, 13).Value = lastrowPrekovremeno

For i = lastrowOS To 3 Step -1
    skip = False
    For k = 1 To list.Count
        If list(k) = Sheets("OS").Cells(i, 1).Value Then
            skip = True
        End If
    Next k
    If Not skip Then
        For j = lastrowPrekovremeno To 3 Step -1
            If Sheets("Prekovremeno").Cells(j, 1).Value = Sheets("OS").Cells(i, 1).Value Then
                list.Add (Sheets("OS").Cells(i, 1).Value)
                Sheets("Prekovremeno").Cells(j, 1).EntireRow.Copy
                Sheets("OS").Cells(i + 1, 1).Insert Shift:=xlDown
            End If
        Next j
    End If
Next i

End Sub

Now next two.

I also made UnDo Chommand Button (Sheet1), in case of a tax click on an unnecessary Chommand Button. And that code doesn't work.

Private mcolUndoObjects As Collection
Private mUndoObject As clsUndoObject

Public Function AddAndProcessObject(oObj As Object, sProperty As String, vValue As Variant) As Boolean
    Set mUndoObject = New clsUndoObject
    With mUndoObject
        Set .ObjectToChange = oObj
        .NewValue = vValue
        .PropertyToChange = sProperty
        mcolUndoObjects.Add mUndoObject
        If .ExecuteCommand = True Then
            AddAndProcessObject = True
        Else
            AddAndProcessObject = False
        End If
    End With
End Function

Private Sub Class_Initialize()
    Set mcolUndoObjects = New Collection
End Sub

Private Sub Class_Terminate()
    ResetUndo
End Sub

Public Sub ResetUndo()
    While mcolUndoObjects.Count > 0
        mcolUndoObjects.Remove (1)
    Wend
    Set mUndoObject = Nothing
End Sub

Public Sub UndoAll()
    Dim lCount As Long
    '    On Error Resume Next
    For lCount = mcolUndoObjects.Count To 1 Step -1
        Set mUndoObject = mcolUndoObjects(lCount)
        mUndoObject.UndoChange
        Set mUndoObject = Nothing
    Next
    ResetUndo
End Sub

Public Sub UndoLast()
    Dim lCount As Long
    '    On Error Resume Next
    If mcolUndoObjects.Count >= 1 Then
        Set mUndoObject = mcolUndoObjects(mcolUndoObjects.Count)
        mUndoObject.UndoChange
        mcolUndoObjects.Remove mcolUndoObjects.Count
        Set mUndoObject = Nothing
    Else
        ResetUndo
    End If
End Sub

Public Function UndoCount() As Long
    UndoCount = mcolUndoObjects.Count
End Function

Private Sub CommandButton2_Click()

End Sub

After inserting the appropriate sheets by clicking on the selected Command Buttons, it is necessary to combine the numbers in the first column. This code works but confirmation is required in the info message to OK for each number being merged. Is it possible all merge cells with one clikc on Command Button?

Private Sub CommandButton1_Click()
Dim lastrowOS As Long
Dim minIndex, maxIndex As Integer
Dim skip As Boolean
Dim list As New Collection

lastrowOS = Cells(Rows.Count, 1).End(xlUp).Row


For i = 3 To lastrowOS
    minIndex = 9999999
    maxIndex = -1
    skip = False
    For k = 1 To list.Count
        If list(k) = Cells(i, 1).Value Then
            skip = True
        End If
    Next k
    If Not skip Then
        For j = 3 To lastrowOS
            If Cells(i, 1).Value = Cells(j, 1).Value Then
                list.Add (Cells(i, 1).Value)
                If j < minIndex Then
                    minIndex = j
                End If
                If j > maxIndex Then
                    maxIndex = j
                End If
            End If
        Next j
        If Not maxIndex = -1 Then
             Range(Cells(maxIndex, 1), Cells(minIndex, 1)).Merge
        End If
    End If
Next i
    
End Sub
    
Option Explicit

Like I said, code runs when it is placed in appropriate sheet. And runs out when it is placed in Sheet2 list also (not errors), but from opened vba editor and clicking on play for run. I need run by one click in Sheet2. If necessary I'll put code here... — Bojan M, Nov 26 '21 at 23:44
To get help, it usually is a good idea to show code that does not work and in this case, also show code that works. "does not work" is vague. Do you mean the event for the button does not fire or is it the references to the cells that are in error? The more you tell the more people may be able to spot the problem. — NoChance, Nov 26 '21 at 23:51
_code runs when it is placed in appropriate sheet_. You probably have unqualified sheet references. If you post your code, we'll know for sure — chris neilsen, Nov 27 '21 at 01:23
`If .ExecuteCommand = True Then` is testing the property of a new object which seems odd. — CDP1802, Nov 28 '21 at 13:41

score 0 · Answer 1 · answered Nov 27 '21 at 21:06

0

Use DisplayAlerts = False to suppress the messages.

Option Explicit
Sub demomerge()

    Dim i As Long, n As Long, lastrowOS As Long
    
    lastrowOS = Cells(Rows.Count, 1).End(xlUp).Row
    n = 0
    Application.DisplayAlerts = False
    For i = 3 To lastrowOS
        n = n + 1
        ' look head
        If Cells(i + 1, 1).Value2 <> Cells(i, 1).Value2 Then
            If n > 1 Then
                Cells(i - n + 1, 1).Resize(n).merge
            End If
            n = 0
        End If
    Next
    Application.DisplayAlerts = True
   
End Sub

answered Nov 27 '21 at 21:06

CDP1802

13,871
2
7
17

CDP1802, that code works. Thanks a lot. – Bojan M Dec 05 '21 at 11:06
If anyone could help me solve just one more code (in Command Button) - UnDo. That code should, of course, return VBA codes previously executed to the OS sheet. If there is no possibility to return more steps, then it will be enough to return for one step. I'm not good enough with Excel VBA encoding, but I found a video on YouTube https://www.youtube.com/watch?v=KqWLfCtiTKc And I posted some UnDo codes above that I tried. – Bojan M Dec 05 '21 at 11:25
@Bojan Which is the code for `clsUndoObject` ? Which class is `AddAndProcessObject` in ? – CDP1802 Dec 05 '21 at 11:45
I re-posted the code above in the post and explained what its function is (to insert rows into the base table). See code and see pictures. And I need the UnDo code in case of clicking on the wrong command button/buttons. In order not to delete the excess of individual inserted lines one by one. – Bojan M Dec 06 '21 at 22:19

Multiple Command Buttons on one Excel sheet

1 Answers1