Option Explicit
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(4).Value ' Replace 4 by 1 to use A-column in Grid instead of D-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(, 3).Value
For i = 2 To UBound(a)
s = UCase(Trim(a(i, 1)))
Grp = a(i, 2) ' group
Acc = a(i, 3) ' account
If Len(Trim(Grp)) > 0 And Len(Trim(Acc)) > 0 Then
If Not (s = "A" Or s = "R") Then
ShImpExp.Cells(i, 1).Select
MsgBox "Wrong code - '" & s & "'" & vbLf & "Use 'A' to add 'X' to Grig" & vbLf & "Use 'R' to remove 'X' from Grid", vbExclamation, "Exit"
Exit Sub
End If
If Not DicGrp.Exists(Grp) Then
ShImpExp.Cells(i, 2).Select
MsgBox "Group '" & Grp & "' not found in the Grig", vbExclamation, "Exit"
Exit Sub
End If
If Not DicAcc.Exists(Acc) Then
ShImpExp.Cells(i, 3).Select
MsgBox "Account '" & Acc & "' not found in the Grig", vbExclamation, "Exit"
Exit Sub
End If
' Update the intersected Account-Group value in the Data()
If s = "A" Then s = "X" Else s = ""
s1 = UCase(Data(DicAcc.Item(Acc), DicGrp.Item(Grp)))
If s = s1 Then
a(i, 1) = a(i, 1) & " - already here"
Else
Data(DicAcc.Item(Acc), DicGrp.Item(Grp)) = s
a(i, 1) = Empty
a(i, 2) = Empty
a(i, 3) = Empty
End If
End If
Next
' Update ImportExport
With ShImpExp.UsedRange.Resize(, 3)
.Value = a()
.Sort .Cells(1), xlAscending, Header:=xlYes
End With
' Update Grig
Rng.Value = Data()
' Release memory of the object variables
Set DicAcc = Nothing
Set DicGrp = Nothing
End Sub
