Update ActiveX code to make Excel macro work on Mac

COwebmaster
COwebmaster used Ask the Experts™
on
I have an Excel macro that uses ActiveX but it doesn't work on my Mac since ActiveX is not supported (get a 429 error). It does work on my PC but I've transitioned over to a MacBook Pro.

Can the following code be converted so that the Excel macro work on my Mac?

Sub GetEmailList()
Dim lr As Long
Dim x, y
Dim dict1 As Object, dict2 As Object
lr = Cells(Rows.Count, 1).End(xlUp).Row
x = Range("A2:A" & lr).Value
lr = Cells(Rows.Count, 2).End(xlUp).Row
y = Range("B2:B" & lr).Value


Set dict1 = CreateObject("Scripting.Dictionary")
Set dict2 = CreateObject("Scripting.Dictionary")

lr = Cells(Rows.Count, 3).End(xlUp).Row
If lr > 1 Then Range("C2:C" & lr).Clear
With dict1
   For i = 1 To UBound(y, 1)
      .Item(y(i, 1)) = ""
   Next i
End With

With dict1
   For i = 1 To UBound(x, 1)
      If Not .exists(x(i, 1)) Then
         dict2.Item(x(i, 1)) = ""
      End If
   Next i
End With
Range("C2").Resize(dict2.Count).Value = Application.Transpose(dict2.keys)

End Sub

Open in new window


Any ideas experts?
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
What version of Excel are you using?

Author

Commented:
Excel Version 16.22 on my Mac
Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
There's nothing in your code that has anything to with an ActiveX control. ActiveX controls are objects that you place on userforms or on worksheets.
Acronis in Gartner 2019 MQ for datacenter backup

It is an honor to be featured in Gartner 2019 Magic Quadrant for Datacenter Backup and Recovery Solutions. Gartner’s MQ sets a high standard and earning a place on their grid is a great affirmation that Acronis is delivering on our mission to protect all data, apps, and systems.

Author

Commented:
Okay take a look at this file. On my Mac, steps 1 and 2 work but on step 3 it throws a 429 error.
Remove-Unsubscribes-and-Invalids-TE.xlsm
Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
What does the error message say?
Older than dirt
Most Valuable Expert 2017
Distinguished Expert 2018
Commented:
See if this works for you.

Sub GetEmailList()
Dim lngLastRow As Long
Dim lngRow As Long
Dim lngNextRow As Long
Dim rngFound As Range

lngLastRow = Range("A1048576").End(xlUp).Row
lngNextRow = 2

If lngLastRow > 1 Then
    Range("C2:C" & lngLastRow).Clear
End If

For lngRow = 2 To lngLastRow
    With ActiveSheet.Columns("B").Cells
        Set rngFound = .Find(What:=Cells(lngRow, "A"), MatchCase:=False)
        If rngFound Is Nothing Then
            Cells(lngNextRow, "C") = Cells(lngRow, "A")
            lngNextRow = lngNextRow + 1
        End If
    End With
Next

End Sub

Open in new window

Author

Commented:
That worked! Thanks Martin :)

Author

Commented:
Hi again Martin. I just tried it using all of my email entries which is around 40K and it's bogged down now. On my PC, it was pretty fast. Seems like Excel is hanging up my computer now. Any ideas?
Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
I added rows 10 and 26.
Sub GetEmailList()
Dim lngLastRow As Long
Dim lngRow As Long
Dim lngNextRow As Long
Dim rngFound As Range

lngLastRow = Range("A1048576").End(xlUp).Row
lngNextRow = 2

Application.ScreenUpdating = False

If lngLastRow > 1 Then
    Range("C2:C" & lngLastRow).Clear
End If

For lngRow = 2 To lngLastRow
    With ActiveSheet.Columns("B").Cells
        Set rngFound = .Find(What:=Cells(lngRow, "A"), MatchCase:=False)
        If rngFound Is Nothing Then
            Cells(lngNextRow, "C") = Cells(lngRow, "A")
            lngNextRow = lngNextRow + 1
        End If
    End With
Next

Application.ScreenUpdating = False

End Sub

Open in new window

Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
Post again if that doesn't help but for now...

You’re welcome and I’m glad I was able to help.

If you expand the “Full Biography” section of my profile you’ll find links to some articles I’ve written that may interest you.

Marty - Microsoft MVP 2009 to 2017
              Experts Exchange Most Valuable Expert (MVE) 2015, 2017
              Experts Exchange Top Expert Visual Basic Classic 2012 to 2018
              Experts Exchange Top Expert VBA 2018
Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
I'd be very interested in knowing if this is faster. If so I'd appreciate it if you selected it as a second answer since I spent several hours on it.
Sub GetEmailList()
Dim lngLastRowA As Long
Dim lngLastRowB As Long
Dim rng As Range
Dim arr As Variant

lngLastRowA = Range("A1048576").End(xlUp).Row
lngLastRowB = Range("B1048576").End(xlUp).Row

Application.ScreenUpdating = False

If lngLastRowA > 1 Then
    ActiveSheet.UsedRange.Cells.Offset(1, 2).ClearContents
End If

'Copy all the values in column 'A' to column 'C'
Range("A2:A" & lngLastRowA).Copy Destination:=Range("C2")

' Create a range consisting of columnb 'B' data
Set rng = Range("B2:B" & lngLastRowB)

' Transpose to a row
arr = Application.WorksheetFunction.Transpose(rng.Value)

' Filter column 'C' based on what's in 'B'
With Range("C1:C" & lngLastRowA)
    .AutoFilter
    .AutoFilter Field:=1, Criteria1:=arr, Operator:=xlFilterValues
End With
    
' Clear the visible cells
Range("C2:C" & lngLastRowA).SpecialCells(xlCellTypeVisible).Clear
' Sort to show the blank ones last!
Range("C1:C" & lngLastRowA).AutoFilter

Columns("C:C").Select
ActiveWorkbook.Worksheets("Create List").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Create List").Sort.SortFields.Add Key:=Range( _
    "C2:C90230"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
With ActiveWorkbook.Worksheets("Create List").Sort
    .SetRange Range("C1:C" & lngLastRowA)
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

' Move the selection off-screen
Range("ZZ1").Select

Application.ScreenUpdating = False

End Sub

Open in new window

Author

Commented:
Got an error - see attached.
Screen-Shot-2019-03-08-at-4.50.14-PM.png
Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
Which line is causing the error?
Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
In addition to my question above, since email addresses are not case sensitive, why are steps 1 and 2 necessary?

Author

Commented:
Those steps are probably not necessary. What I need to do is remove any extra spaces surrounding the email so I guess trim them and also remove any unforeseen commas or semi-colons and remove any emails that don't have an @ symbol.

I'll have to check what line that is and will let you know today.

Author

Commented:
Okay the debugger showed me this screenshot.

Any ideas?
Screen-Shot-2019-03-15-at-10.06.22-A.png
Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
I'm sorry but I'm embarrassed to say that that code of mine doesn't work at all, so please ignore that post.

Author

Commented:
Okay any other suggestions on making your first post faster?
Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
About how long does it take to run with real data?

Author

Commented:
with a list of 40K it took about an hour. On a PC, it's almost instantaneous.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial