Change VBA code for Mac compatibility

ddewilt

New Member
Joined
Sep 18, 2017
Messages
26
Hi,

I got the following code thanks to MickG here on this forum, which helped me a lot! It worked on Excel on Windows, but on the Mac, where it's gonna be used, it doesn't..

I imported the Dictionary.cls and KeyValuePair.cls from https://sysmod.wordpress.com/2011/11...ng-dictionary/, but I can't get it to work.. any idea what to do to make it work?

Here's the original code:

Code:
[/COLOR][COLOR=#333333][FONT=Georgia]Private Sub Worksheet_Change(ByVal Target As Range)[/FONT][/COLOR][COLOR=#333333][FONT=Georgia]Dim Dn As Range
Dim Rng As Range
Dim nRng As Range
Dim Dic As Object
Dim Ac As Long
Dim k As Variant
Dim p As Variant, Sp As Variant
Dim c As Long, Wk As Long, n As Long
With Sheets(“Sheet1”)
Set Rng = .Range(“C3”, .Range(“C” & Rows.Count).End(xlUp))
End With
Set nRng = Rng.Offset(, 1).Resize(, 52)
If Not Intersect(nRng, Target) Is Nothing Then
Set Dic = CreateObject(“Scripting.Dictionary”)
Dic.CompareMode = 1
For Each Dn In Rng
For Ac = 1 To 52
If Dn.Offset(, Ac).Value “” Then
If Not Dic.exists(Dn.Offset(, Ac).Value) Then
Set Dic(Dn.Offset(, Ac).Value) = CreateObject(“Scripting.Dictionary”)
End If[/FONT][/COLOR]
[COLOR=#333333][FONT=Georgia]If Not Dic(Dn.Offset(, Ac).Value).exists(Dn.Value) Then
Dic(Dn.Offset(, Ac).Value).Add (Dn.Value), Rng(1).Offset(-1, Ac).Value
Else
Dic(Dn.Offset(, Ac).Value).Item(Dn.Value) = Dic(Dn.Offset(, Ac).Value).Item(Dn.Value) _
& “, ” & Rng(1).Offset(-1, Ac).Value
End If
End If
Next Ac
Next Dn[/FONT][/COLOR]
[COLOR=#333333][FONT=Georgia]With Sheets(“Sheet2”)
.Range(“A:B”).ClearContents
For Wk = 1 To 52
For Each k In Dic.Keys
If Val(k) = Wk Then
c = c + 1
.Cells(c, 1) = “Week ” & k
c = c + 1
For Each p In Dic(k)
.Cells(c, 1) = p
Sp = Split(Dic(k).Item(p), “, “)
For n = 0 To UBound(Sp)
.Cells(c, 2) = Sp(n)
c = c + 1
Next n
Next p
End If
Next k
Next Wk
End With
End If
End Sub[FONT=Verdana]

Any idea what to add/replace to call that dictionary/[/FONT]KeyValuePair?[/FONT]
 

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.
Those smart quotes and missing text are making it much harder! If you've imported the .cls files into your project then this might work:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)


Dim Dn As Range
Dim Rng As Range
Dim nRng As Range
Dim Dic As Dictionary
Dim Ac As Long
Dim k As Variant
Dim p As Variant, Sp As Variant
Dim c As Long, Wk As Long, n As Long


With Sheets("Sheet1")
    Set Rng = .Range("C3", .Range("C" & Rows.Count).End(xlUp))
End With


Set nRng = Rng.Offset(, 1).Resize(, 52)


If Not Intersect(nRng, Target) Is Nothing Then
    Set Dic = New Dictionary
    Dic.CompareMode = 1
    
    For Each Dn In Rng
        For Ac = 1 To 52
            If Dn.Offset(, Ac).value <> "" Then
                If Not Dic.Exists(Dn.Offset(, Ac).value) Then
                    Set Dic(Dn.Offset(, Ac).value) = New Dictionary
                End If
                
                If Not Dic(Dn.Offset(, Ac).value).Exists(Dn.value) Then
                    Dic(Dn.Offset(, Ac).value).Add Dn.value, Rng(1).Offset(-1, Ac).value
                Else
                    Dic(Dn.Offset(, Ac).value).Item(Dn.value) = Dic(Dn.Offset(, Ac).value).Item(Dn.value) & ", " & Rng(1).Offset(-1, Ac).value
                End If
            End If
        Next Ac
    Next Dn
    
    With Sheets("Sheet2")
        .Range("A:B").ClearContents
        For Wk = 1 To 52
            For Each k In Dic.Keys
                If Val(k) = Wk Then
                    c = c + 1
                    .Cells(c, 1) = "Week " & k
                    c = c + 1
                    For Each p In Dic(k)
                        .Cells(c, 1) = p
                        Sp = Split(Dic(k).Item(p), ", ")
                        For n = 0 To UBound(Sp)
                            .Cells(c, 2) = Sp(n)
                            c = c + 1
                        Next n
                    Next p
                End If
            Next k
        Next Wk
    End With
End If


End Sub

Totally untested because I don't know what the code is intended to do.

WBD
 
Upvote 0
Thanks for your reply!

Here is what posted a few day's ago:

I have 2 sheets: On Sheet 1 on row 3 in Column E there's a name and from Column F to AD are weeknumbers (1 to 51). Per action you can fill in a weeknumber which that action has to take place. On Sheet 2 I need to insert a name with rows depending how many actions that week need to be done.

SHEET 1
Toprow (row2), beginning on column E and the actions from F to AD:
Columns: E F G ... .... ...
ROW 2 :Name | Action 1 | Action 2 | Action 3 | Action 4 | Action 5 | Action 6 | Action 7 | Action 8 | Action 9 | and so on...

Datarow (row3 to row X) where on column E is the name and F to AD presenting the weeknumbers:
ROW 3 :John | 1 | 5 | 15 | 1 | ...


Now, on Sheet 2, I have the weeknumbers below eachother in Column A:

SHEET 2
Week 1

Week 2

....

What I need is to put the name in the right week with the right actions (insert rows based on how many 1's, 2's etc.)... So, if John has actions in week 1, his name has to be under Week 1, if there are two 1's in the range F to AD, there has to be 2 rows inserted with the name of the actions:

SHEET 2
Week 1
Name | Actionname
John | Action 1
Action 4
etc..

So this worked on Windows, but not on Mac..
If I'm using your code, he gives a Compile error - Can't assign on read-only property on the line:
Code:
Dic.CompareMode = 1
 
Upvote 0
It's a read-only property in the replacement class. Remove that line I think since vbTextCompare (=1) is the default.

WBD
 
Upvote 0
Oke, 'Object doesn't support this property or method.. I'll also tried to add
Code:
[COLOR=#333333]vbTextCompare (=1)[/COLOR]
instead of
Code:
[COLOR=#333333]Dic.CompareMode = 1[/COLOR]
, but no effect..:confused:
 
Upvote 0
Sorry I wasn't clear; just delete that line of code completely.

WBD

I just deleted the line of code, but unfortunately it didn't work..:confused:..

MickG rewrote the code so I won't need the Scripting Dictionary. This problem is solved, but not with the custom Dictionary..But thanks for the help, I appreciate it a lot!!

See the corrected code here:
Code:
Private [COLOR=Navy]Sub[/COLOR] Worksheet_Change(ByVal Target [COLOR=Navy]As[/COLOR] Range)
[COLOR=Navy]Dim[/COLOR] Dn [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Rng [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] nRng [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] c [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] Ac1 [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] Ac2 [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] n [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] R [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]With[/COLOR] Sheets("Sheet1")
[COLOR=Navy]Set[/COLOR] Rng = .Range("C3", .Range("C" & Rows.Count).End(xlUp))
[COLOR=Navy]End[/COLOR] With
[COLOR=Navy]Set[/COLOR] nRng = Rng.Offset(, 1).Resize(, 52)
ReDim ray(1 To 52) [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]If[/COLOR] Not Intersect(nRng, Target) [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR]
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
[COLOR=Navy]For[/COLOR] Ac1 = 1 To 52
[COLOR=Navy]For[/COLOR] Ac2 = 1 To 52
[COLOR=Navy]If[/COLOR] Dn.Offset(, Ac2).Value = Ac1 [COLOR=Navy]Then[/COLOR]
[COLOR=Navy]If[/COLOR] ray(Ac1) [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR] [COLOR=Navy]Set[/COLOR] ray(Ac1) = Dn.Offset(, Ac2) Else [COLOR=Navy]Set[/COLOR] ray(Ac1) = Union(ray(Ac1), Dn.Offset(, Ac2))
[COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR] Ac2
[COLOR=Navy]Next[/COLOR] Ac1
[COLOR=Navy]Next[/COLOR] Dn
[COLOR=Navy]With[/COLOR] Sheets("Sheet2")
.Range("A:B").ClearContents
[COLOR=Navy]For[/COLOR] n = 1 To 52
[COLOR=Navy]If[/COLOR] Not ray(n) [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR]
c = c + 1
.Cells(c, 1) = "Week " & ray(n)(1)
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] R [COLOR=Navy]In[/COLOR] ray(n)
c = c + 1
.Cells(c, 1) = Cells(R.Row, "C")
.Cells(c, 2) = Cells(2, R.Column)
[COLOR=Navy]Next[/COLOR] R
[COLOR=Navy]End[/COLOR] If
[COLOR=Navy]If[/COLOR] Not ray(n) [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR] c = c + 1
[COLOR=Navy]Next[/COLOR] n
[COLOR=Navy]End[/COLOR] With
[COLOR=Navy]End[/COLOR] If
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
 
Last edited:
Upvote 0

Forum statistics

Threads
1,223,885
Messages
6,175,183
Members
452,615
Latest member
bogeys2birdies

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top