Macro works but will not work when run as VBA

[Emerald]

I have a macro created that works fine. However, when I try to get it to run from an ActiveX button, it does not work at all.

Is there a certain mode or option I have to toggle to get it to work?

Macro is as follows:

Sub Combine() 
     '
     ' Combine Macro
     '
     '
    Application.ScreenUpdating = False 
     
     'Clears current list
    Sheets("Sheet3").Select 
    Columns("J:J").Select 
    Selection.ClearContents 
     'Copy paste from other sheets
    Sheets("Sheet2").Select 
    Range("C2:C1500").Select 
    Selection.Copy 
    Sheets("Sheet3").Select 
    Range("J2").Select 
    ActiveSheet.Paste 
    Sheets("Sheet1").Select 
    Range("C2:C1500").Select 
    Application.CutCopyMode = False 
    Selection.Copy 
     'Selects first empty row
    Sheets("Sheet3").Select 
    Range("J2").Select 
    Do 
        If IsEmpty(ActiveCell) = False Then 
            ActiveCell.Offset(1, 0).Select 
        End If 
    Loop Until IsEmpty(ActiveCell) = True 
     
    ActiveSheet.Paste 
     
     
     'Removes duplicates and sorts column
    Columns("J:J").Select 
    Application.CutCopyMode = False 
    ActiveSheet.Range("$J$1:$J$3157").RemoveDuplicates Columns:=1, Header:=xlNo 
    ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear 
    ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("J1:J3157") _ 
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
    With ActiveWorkbook.Worksheets("Sheet3").Sort 
        .SetRange Range("J1:J3157") 
        .Header = xlGuess 
        .MatchCase = False 
        .Orientation = xlTopToBottom 
        .SortMethod = xlPinYin 
        .Apply 
    End With 
End Sub 

Thanks in advance,

[Smallman]

Hi Emerald

Lets start by cleaning your code up a bit. I am not sure what the sort at the bottom is trying to achieve. THe attached file assumes no headers.

Take care

Smallman

Option Explicit 
Private Sub CommandButton1_Click() 
    Application.ScreenUpdating = False 
     
     'Clears current list
    Sheets("Sheet3").Range("J:J").ClearContents 
    Sheets("Sheet2").Range("C2:C1500").Copy Sheets("Sheet3").Range("J2") 
    Sheets("Sheet1").Range("C2:C1500").Copy Sheets("Sheet3").Range("J" & Rows.Count).End(xlUp)(2) 
     'Removes duplicates and sorts column
    Sheets("Sheet3").Range("J1", Range("J" & Rows.Count).End(xlUp)).RemoveDuplicates 1, xlNo 
    Sheets("Sheet3").Range("J2", Range("J" & Rows.Count).End(xlUp)).Sort Columns(10), xlAscending 
     
End Sub 

[Apcbr]

You cleaned it up nicely Smallman :-)
Emerald, the code is not working because the code was not linked to the "click" event of the button. (Just in case you hadn't figured it out from Smallman's code)

Greetings,
Apcbr

[Emerald]

Thank you very much Smallman!

@Apcbr - I had tried putting the macro code under a button click Sub, but it would give me "Select method of Range class failed" error.

I was getting the same error using Smallman's code also. But, thanks to the example spreadsheet he attached, I saw that the only difference between my sheet and his was that on mine, the button was on Sheet2. On his, it is on Sheet3.

Moving the button to Sheet3 seems to be working well

Thanks again!

[Smallman]

Hi Emerald

Thanks glad you got the procedure working. In future it is a good idea to attach a sample of your workbook that way there is no confusion.

Acpbr - the code is linked to the click event of the button, in contrast to your informed comment. The code runs so quickly it appears nothing is happening. However go into the file, clear the range on sheet3 click the button. Works doesn't it!!!

Take it easy

Smallman

[Apcbr]

Yes it does Smallman,

I was referring to Emeralds code that did not seem to be linked to the click event

Cheers,
Apcbr

[Smallman]

Oh Ok I am sorry then. I thought you were saying the code didn't work. I misunderstood. This time my bad.

Take it easy

Smallman

[jindon]

This should work even the button is in Sheet2

Sub Combine() 
    Application.ScreenUpdating = False 
    With Sheets("Sheet3") 
         'Clears current list
        .Columns("J").ClearContents 
         'Copy paste from other sheets
        Sheets("Sheet2").Range("C2:C1500").Copy .Range("J2") 
        Sheets("Sheet1").Range("C2:C1500").Copy .Range("j" & Rows.Count).End(xlUp)(2) 
        .Range("$J$1:$J$3157").RemoveDuplicates Columns:=1, Header:=xlNo 
        .Range("J2:J3157").Sort .Range("J2"), 1 
    End With 
End Sub