MobileMobile | Continue

Excel Bar

Excel Bar

Your excel questions will be responsed by our excel experts within 24hrs.Our service is free.

 Forgot Pass?
 Register Now
Find
Hot Search: Vlookup Match VBA
View: 280|Reply: 8

Duplicating code for use with multiple select button withou

[Copy link]

2

Topics

5

Posts

16

Integral

Member

Rank: 2

Integral
16
Post on 2-11-2017 15:15:41 | All posts |Read mode
I have workbook (sample attached) that requires pasting an active cell and an offset range adjacent to the active cell in a separate worksheet that corresponds to a given select button that is clicked.
The jist of the functionality is listed below:
1- Copy the active cell along with several cells adjacent to the active cell (example: copy active cell = cell D:200 + E:200 through U:200)
2- Paste values of all those cells in the next available (empty) row in say sheet2.
3- Message box confirming that cells have been pasted
4- Hide or possibly Delete the row the entire row from which all the cells were copied from.
As stated, all the above works (for 1 button at this time).
However, the new issue is the fact that there will be up to 15 buttons that need to the exact same thing as listed above. Each button will paste the data selected from item 1 above and paste it to a corresponding worksheet (i.e. - button 1 will paste the selection to sheet 1, button 2 would paste to sheet 2 and so on).
Now that I have the coded worked out for button 1, I want to replicate for the remaining buttons without duplicating/replicating/reusing the code. My initial thought was to use a Select Case to figure out which button was clicked and then pass the string to the With Sheets( ) routine that I created.
Hoping I can get some direction on how to accomplish the above without wasting/reusing code needlessly.
Thanks in advance for the help. (Current code used is below and I've attached sample workbook as well).









  • Copy_Paste_VBA_Sample.xlsm
    (41.2 KB, 0 views)
    Download








  • Reply

    Props Report

    3

    Topics

    110

    Posts

    255

    Integral

    Conqueror

    Rank: 3Rank: 3

    Integral
    255
    Post on 2-11-2017 15:39:24 | All posts



    lukasd,
    If there is nothing in the active cell nor the adjacent cells that could be used as an indicator of which sheet the pasted cells were to go, I think the best approach is to first have the code open a form with a combobox that auto populates with the sheet names and waits for a selection.  Using the combobox's value, the code continues, navigates to the correct sheet/cell, and pastes the cell data.
    Maud
    Reply Support Opposition

    Props Report

    3

    Topics

    110

    Posts

    255

    Integral

    Conqueror

    Rank: 3Rank: 3

    Integral
    255
    Post on 2-11-2017 17:20:42 | All posts



    lukasd,
    If there is nothing in the active cell nor the adjacent cells that could be used as an indicator of which sheet the pasted cells were to go, I think the best approach is to first have the code open a form with a combobox that auto populates with the sheet names and waits for a selection.  Using the combobox's value, the code continues, navigates to the correct sheet/cell, and pastes the cell data.
    Maud




    Reply Support Opposition

    Props Report

    8

    Topics

    1046

    Posts

    2284

    Integral

    King

    Rank: 6Rank: 6

    Integral
    2284
    Post on 2-11-2017 18:30:46 | All posts



    The simplest way would be to define a global variable and, for each button, set it to an index number; 1 for button 1, 2 for button 2, etc., up to 15 for button 15.  Then call a generic subroutine that picks up the index from the global variable and processes the relevant sheet(s) and range(s).  Adapt your existing code as necessary.











    Reply Support Opposition

    Props Report

    8

    Topics

    1046

    Posts

    2284

    Integral

    King

    Rank: 6Rank: 6

    Integral
    2284
    Post on 2-11-2017 19:21:15 | All posts



    ' Post this code into a STANDARD module
    ' NOT in a sheet class module
    ' Assign macro Button1 to the Sheet 1 button, etc.
    Option Explicit
    Dim giIndex As Integer
    Sub Button1()
    giIndex = 1
    SelectAndPaste
    End Sub
    Sub Button2()
    giIndex = 2
    SelectAndPaste
    End Sub
    Sub Button3()
    giIndex = 3
    SelectAndPaste
    End Sub
    Sub Button4()
    giIndex = 4
    SelectAndPaste
    End Sub
    Sub Find_First()
        Dim FindString As String
        Dim Rng As Range
        FindString = Sheets(D List).Range(E2).Value
        If Trim(FindString)   Then
            With Sheets(D List).Range(D:D)
                Set Rng = .Find(What:=FindString, _
                                After:=.Cells(.Cells.Count), _
                                LookIn:=xlValues, _
                                LookAt:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=False)
                If Not Rng Is Nothing Then
                    Application.Goto Rng, False
                Else
                    MsgBox Nothing found
                End If
            End With
        End If
    End Sub
    Sub Return_Home()
    Application.Goto Sheets(D List).Range(A1), True
    End Sub
    Sub SelectAndPaste()
    With ActiveCell
        .Resize(, 18).Copy
        .EntireRow.Hidden = True
    End With
    With Sheets(S   giIndex)
        .Range(a65000).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    End With
    Application.CutCopyMode = False
    End Sub
    Reply Support Opposition

    Props Report

    8

    Topics

    1046

    Posts

    2284

    Integral

    King

    Rank: 6Rank: 6

    Integral
    2284
    Post on 2-12-2017 01:19:03 | All posts



    ' Post this code into a STANDARD module
    ' NOT in a sheet class module
    ' Assign macro Button1 to the Sheet 1 button, etc.
    Option Explicit
    Dim giIndex As Integer
    Sub Button1()
    giIndex = 1
    SelectAndPaste
    End Sub
    Sub Button2()
    giIndex = 2
    SelectAndPaste
    End Sub
    Sub Button3()
    giIndex = 3
    SelectAndPaste
    End Sub
    Sub Button4()
    giIndex = 4
    SelectAndPaste
    End Sub
    Sub Find_First()
        Dim FindString As String
        Dim Rng As Range
        FindString = Sheets(D List).Range(E2).Value
        If Trim(FindString)   Then
            With Sheets(D List).Range(D:D)
                Set Rng = .Find(What:=FindString, _
                                After:=.Cells(.Cells.Count), _
                                LookIn:=xlValues, _
                                LookAt:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=False)
                If Not Rng Is Nothing Then
                    Application.Goto Rng, False
                Else
                    MsgBox Nothing found
                End If
            End With
        End If
    End Sub
    Sub Return_Home()
    Application.Goto Sheets(D List).Range(A1), True
    End Sub
    Sub SelectAndPaste()
    With ActiveCell
        .Resize(, 18).Copy
        .EntireRow.Hidden = True
    End With
    With Sheets(S   giIndex)
        .Range(a65000).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    End With
    Application.CutCopyMode = False
    End Sub









    Reply Support Opposition

    Props Report

    2

    Topics

    5

    Posts

    16

    Integral

    Member

    Rank: 2

    Integral
    16
     Author| Post on 2-12-2017 02:03:16 | All posts



    Thank you so much!! That works perfectly as planned. This forum and people in it ROCK!
    Reply Support Opposition

    Props Report

    2

    Topics

    5

    Posts

    16

    Integral

    Member

    Rank: 2

    Integral
    16
     Author| Post on 2-12-2017 04:59:31 | All posts



    Thank you so much!! That works perfectly as planned. This forum and people in it ROCK!




    Reply Support Opposition

    Props Report

    8

    Topics

    1046

    Posts

    2284

    Integral

    King

    Rank: 6Rank: 6

    Integral
    2284
    Post on 2-12-2017 06:29:26 | All posts



    You're welcome.

    If you are satisfied with the solution(s) provided, please mark your thread as Solved.

    New quick method:
    Select Thread Tools- Mark thread as Solved. To undo, select Thread Tools- Mark thread as Unsolved.
    Or you can use this way:
    How to mark a thread Solved
    Go to the first post
    Click edit
    Click Go Advanced
    Just below the word Title you will see a dropdown with the word No prefix.
    Change to Solved
    Click Save

    You may also want to consider thanking those people who helped you
    [color=]by clicking on the little star at the bottom
    left of their reply to your question.
    Reply Support Opposition

    Props Report

    Points policy of this forum

    Archiver|Mobile|Small dark house|Contact us|Excel Bar

    GMT-5, 9-21-2017 14:36 , Processed in 0.127385 second(s), 20 queries .

    Powered by Discuz! X3

    © 2001-2013 Comsenz Inc.

    !fastreply! Top !return_list!