Sub UpdateGrid()
Const DataCell = "O7"
Dim ShGrid As Worksheet, ShImpExp As Worksheet
Dim Rng As Range
Dim DicAcc As Object, DicGrp As Object
Dim Acc As Variant, Grp As Variant
Dim a() As Variant, Data() As Variant
Dim i As Long
Dim s As String, s1 As String
Set ShGrid = Sheets("Grid")
Set ShImpExp = Sheets("ImportExport")
' Create dictionaries for accounts and groups
Set DicAcc = CreateObject("Scripting.Dictionary")
Set DicGrp = CreateObject("Scripting.Dictionary")
DicAcc.CompareMode = 1
DicGrp.CompareMode = 1
With ShGrid.Range("A1").CurrentRegion
' Copy Grid X's data to the Data()
Set Rng = .Range(DataCell).Resize(.Rows.Count - .Range(DataCell).Row + 1, .Columns.Count - .Range(DataCell).Column + 1)
Data() = Rng.Value
' Put accounts and their rows to the dictionary
a() = Rng.EntireRow.Columns(1).Value ' Replace 1 by 4 to use D-column in Grid instead of A-column
For i = 1 To UBound(a)
DicAcc.Item(a(i, 1)) = i
Next
' Put groups and their columns to the dictionary
a() = Rng.Offset(-1).Value
For i = 1 To UBound(a, 2)
DicGrp.Item(a(1, i)) = i
Next
End With
' Main
a() = ShImpExp.UsedRange.Resize(, 4).Value
For i = 2 To UBound(a)
s = UCase(Trim(a(i, 1))) ' "A" to add or "R" to remove
Grp = a(i, 2) ' Group
Acc = a(i, 3) ' Account
a(i, 4) = Empty ' Result
If Len(Trim(Grp)) > 0 And Len(Trim(Acc)) > 0 Then
If Not (s = "A" Or s = "R") Then a(i, 4) = "Wrong 'A'/'R' code"
If Not DicGrp.Exists(Grp) Then a(i, 4) = IIf(Len(a(i, 4)) > 0, a(i, 4) & ", ", "") & "Group doesn't exist"
If Not DicAcc.Exists(Acc) Then a(i, 4) = IIf(Len(a(i, 4)) > 0, a(i, 4) & ", ", "") & "Account doesn't exist"
' Update the intersected Account-Group value in the Data()
If s = "A" Then s = "X" Else s = ""
If Len(a(i, 4)) = 0 Then
s1 = UCase(Data(DicAcc.Item(Acc), DicGrp.Item(Grp)))
If s = s1 Then
If a(i, 1) = "A" Then
a(i, 4) = "Already exists"
ElseIf a(i, 1) = "R" Then
a(i, 4) = "No X's exist to remove"
End If
Else
Data(DicAcc.Item(Acc), DicGrp.Item(Grp)) = s
a(i, 4) = "Successfully " & IIf(s = "X", "addeed", "removed")
End If
End If
End If
Next
' Update ImportExport
ShImpExp.UsedRange.Resize(, 4).Value = a()
' Update Grig
Rng.Value = Data()
' Release memory of the object variables
Set DicAcc = Nothing
Set DicGrp = Nothing
End Sub
