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
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
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)
Grp = a(i, 2) ' group
Acc = a(i, 3) ' account
If Len(Trim(Grp)) > 0 And Len(Trim(Acc)) > 0 Then
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()
Data(DicAcc.Item(Acc), DicGrp.Item(Grp)) = IIf(UCase(Trim(a(i, 1))) = "A", "X", "")
End If
Next
' Update Grig
Rng.Value = Data()
' Release memory of the object variables
Set DicAcc = Nothing
Set DicGrp = Nothing
End Sub
