Home > Mobile >  Excel VBA combine two SUBs
Excel VBA combine two SUBs

Time:05-17

Any chance of getting help combining the two below codes?

I'll try to educate myself on combining these things as I'm sure it's not that complicated, but for now I'd appreciate any assistance.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Application.CutCopyMode = False Then
Application.Calculate
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim UndoList As String

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    On Error GoTo ErrExit
    UndoList = Application.CommandBars("Standard").Controls("&Undo").List(1)
    If Left(UndoList, 5) = "Paste" Or UndoList = "Auto Fill" Then
        MsgBox "Copy / paste is not permitted" & vbCr & _
               "- Creator"
        With Application
            .Undo
            .CutCopyMode = False
        End With
        Target.Select
    End If
    'The UperCase part______________________________________________
    If Not (Application.Intersect(Target, Range("E8:OF57")) _
                                                    Is Nothing) Then
        With Target
            If Not .HasFormula Then
                Application.EnableEvents = False
                .Value = UCase(.Value)
                Application.EnableEvents = True
            End If
        End With
    End If
    '_______________________________________________________________

ErrExit:
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

I'm trying to make my workbook as easy to use as possible, and to avoid user mistakes that mess upp formulas and so forth.

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
    Dim MyPicture As Object
    Dim MyTop As Double
    Dim MyLeft As Double
    Dim TopRightCell As Range
    '-----------------------------------------------------------
    '- top right cell
    With ActiveWindow.VisibleRange
        r = 1
        c = .Columns.Count
        Set TopRightCell = .Cells(r, c)
    End With
    '------------------------------------------------------------
    '- position picture
    Set MyPicture = ActiveSheet.Pictures(1)
    MyLeft = TopRightCell.Left - MyPicture.Width - 200
    With MyPicture
        .Left = MyLeft
    End With
End Sub

CodePudding user response:

The line starting with Private Sub or Sub begins the macro, and the line End Sub is the end of the macro.

Of the two code blocks you've pasted, the top contains two macros (one Worksheet_SelectionChange and one Worksheet_Change), and the second block only contains a SelectionChange one.
Depending which of those you wish to merge, just cut-paste the code from the inside of one sub (i.e. not including the start and end lines Private Sub and End Sub) into another, to make an amalgamated sub containing both sets of code. You may wish to amalgamate all three, but I'd guess it's just the two SelectionChange subs you want to merge.

  • Related