Change VBA code for Mac compatibility

[ddewilt]

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:

[/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]

 

[wideboydixon]

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:

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]

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:

Dic.CompareMode = 1

 

[wideboydixon]

It's a read-only property in the replacement class. Remove that line I think since vbTextCompare (=1) is the default.

WBD

 

[ddewilt]

Oke, 'Object doesn't support this property or method.. I'll also tried to add

[COLOR=#333333]vbTextCompare (=1)[/COLOR]

instead of

[COLOR=#333333]Dic.CompareMode = 1[/COLOR]

, but no effect..

 

[wideboydixon]

Sorry I wasn't clear; just delete that line of code completely.

WBD

 

[MickG]

ddewilt, Please see your original post for new code !!!!

 

[ddewilt]

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....

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:

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]