Change VBA code for Mac compatibility

ddewilt

New Member
Joined
Sep 18, 2017
Messages
20
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]
 

Some videos you may like

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"

wideboydixon

Well-known Member
Joined
Jun 2, 2016
Messages
3,401
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
 

ddewilt

New Member
Joined
Sep 18, 2017
Messages
20
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
 

wideboydixon

Well-known Member
Joined
Jun 2, 2016
Messages
3,401
It's a read-only property in the replacement class. Remove that line I think since vbTextCompare (=1) is the default.

WBD
 

ddewilt

New Member
Joined
Sep 18, 2017
Messages
20
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:
 

ddewilt

New Member
Joined
Sep 18, 2017
Messages
20
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:

Watch MrExcel Video

Forum statistics

Threads
1,099,000
Messages
5,465,943
Members
406,453
Latest member
MarkB5432

This Week's Hot Topics

Top