VBA help to import/export list of data to populate a grid

[ItalianPlatinum]

Hello - I couldn't find anything to uniquely accomplish what I am ultimately trying to do.

1. I have a grid of data where column A7 down is my account #
2. Starting at O6 to no end zz6 say for sake of argument where the accounts are grouped by a group #
3. Currently I manually update the grid to place an X if the account is in the group #
   1. my file is going to grow exponentially so I can no longer manually support

Looking for a way in another tab to just list group #, Account #, then Add or remove then it will update the grid to clear X's if removed or add X if adding. For example below is a mocked up grid.

Book1
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W
1	Count														10	2	2	6	4	10	2	10	6
2	Purpose														Tracking	label	ship	Needs	XXX	XXX	XXX	XXX	XXX
3	Owner														Team 1	Team 1	Team 1	Team 1	Team 1	Team 1	Team 1	Team 1	Team 1
4	Unique														Unique	Basic	Unique	Basic	Unique	Basic	Unique	Basic	Basic
5	Account	Desc 1	Desc 2	Account #	Name	Filler	Filler	Filler	Filler	Filler	Filler	Filler	Filler	Filler	Group 1	Group 2	Group 3	Group 4	Group 5	Group 6	Group 7	Group 8	Group 9
6															10000	20000	30000	40000	50000	60000	70000	80000	90000
7	1	Large	L1	XX1	J	NA	NA	NA	NA	NA	NA	NA	NA	NA	X	X			X	X	X	X	X
8	2	Large	L2	XX2	M	NA	NA	NA	NA	NA	NA	NA	NA	NA	X	X			X	X	X	X	X
9	3	Large	L3	XX3	L	NA	NA	NA	NA	NA	NA	NA	NA	NA	X		X		X	X		X	X
10	4	Large	L4	XX4	O	NA	NA	NA	NA	NA	NA	NA	NA	NA	X		X		X	X		X	X
11	5	Medium	L5	XX5	P	NA	NA	NA	NA	NA	NA	NA	NA	NA	X			X		X		X	X
12	6	Medium	L6	XX6	Q	NA	NA	NA	NA	NA	NA	NA	NA	NA	X			X		X		X	X
13	7	Medium	L7	XX7	R	NA	NA	NA	NA	NA	NA	NA	NA	NA	X			X		X		X
14	8	Small	L8	XX8	S	NA	NA	NA	NA	NA	NA	NA	NA	NA	X			X		X		X
15	9	Small	L9	XX9	T	NA	NA	NA	NA	NA	NA	NA	NA	NA	X			X		X		X
16	10	Small	L10	XX10	U	NA	NA	NA	NA	NA	NA	NA	NA	NA	X			X		X		X
Grid

Cell Formulas
Range	Formula
O1:W1	O1	=COUNTA(O7:O10000)

 

[ItalianPlatinum]

Anyone able to help

 

[ZVI]

... Looking for a way in another tab to just list group #, Account # ...

Hi,

As the Account-Group data layout in another tab is not posted, it is not clear the destination data are just numbers or strings from the ranges.
Your code attempt, if exists, will be helpful to see what and where the problem is.
If code does not exist then start playing with the below suggestions.
Assuming that the accounts and groups are incremented by +1 as shown in the post #1, to auto-create Accounts-Groups list in another tab put the below code into code module of that another sheet. Change sheet selection to see the result.

Option Explicit

' Put this code into VBA module of the sheet with Accoubt-Croup list
' It is assumed that Accounts in the A7:A... are incremented by +1, as well as Groups in the row #5 of the main table

Private Sub Worksheet_Activate()

  Const DataCell = "O7"
  Dim ShTable As Worksheet, ShList As Worksheet
  Dim Rng As Range
  Dim Data() As Variant, Dest() As Variant
  Dim i As Long, j As Long, k As Long

  Set ShTable = Sheets("Sheet1")  ' Sheet with data table
  Set ShList = Me                 ' This sheet for Accounts-Groups list

  With ShTable.Range("A1").CurrentRegion
    Set Rng = .Range(DataCell).Resize(.Rows.Count - .Range(DataCell).Row + 1, .Columns.Count - .Range(DataCell).Column + 1)
    Data() = Rng.Value
  End With

  ReDim Dest(1 To UBound(Data) * UBound(Data, 2), 1 To 2)
  For i = 1 To UBound(Data)
    For j = 1 To UBound(Data, 2)
      If Data(i, j) = "X" Then
        k = k + 1
        Dest(k, 1) = i  ' Account #
        Dest(k, 2) = j  ' Group #
      End If
    Next
  Next

  With ShList.UsedRange.Resize(, 2)
    Application.ScreenUpdating = False
    .ClearContents
    .Rows(1) = Array("Account", "Group")
    If k > 0 Then
      .Offset(1).Resize(k).Value = Dest()
    End If
    Application.ScreenUpdating = True
  End With

End Sub

The result looks as follows:

Wb1.xlsb
	A	B
1	Account	Group
2	1	1
3	1	2
4	1	5
5	1	6
6	1	7
7	1	8
8	1	9
9	2	1
10	2	2
11	2	5
12	2	6
13	2	7
14	2	8
15	2	9
16	3	1
17	3	3
18	3	5
19	3	6
20	3	8
21	3	9
22	4	1
23	4	3
24	4	5
25	4	6
26	4	8
27	4	9
28	5	1
29	5	4
30	5	6
31	5	8
32	5	9
33	6	1
34	6	4
35	6	6
36	6	8
37	6	9
38	7	1
39	7	4
40	7	6
41	7	8
42	8	1
43	8	4
44	8	6
45	8	8
46	9	1
47	9	4
48	9	6
49	9	8
50	10	1
51	10	4
52	10	6
53	10	8
Sheet2

 

[ZVI]

Just for the case - below is the version for getting Account# from the D-column and Group# from the 5th row:

Option Explicit

' Put this code into VBA module of the sheet with Accoubt-Croup list
' It is assumed that Accounts in the A7:A... are incremented by +1, as well as Groups in the row #5 of the main table

Private Sub Worksheet_Activate()

  Const DataCell = "O7"
  Dim ShTable As Worksheet, ShList As Worksheet
  Dim Rng As Range
  Dim Acc() As Variant, Grp() As Variant, Data() As Variant, Dest() As Variant
  Dim i As Long, j As Long, k As Long

  Set ShTable = Sheets("Sheet1")
  Set ShList = Me

  With ShTable.Range("A1").CurrentRegion
    Set Rng = .Range(DataCell).Resize(.Rows.Count - .Range(DataCell).Row + 1, .Columns.Count - .Range(DataCell).Column + 1)
    Acc() = Rng.EntireRow.Columns(4).Value
    Grp() = Rng.Offset(-2).Value
    Data() = Rng.Value
  End With

  ReDim Dest(1 To UBound(Data) * UBound(Data, 2), 1 To 2)
  For i = 1 To UBound(Data)
    For j = 1 To UBound(Data, 2)
      If Data(i, j) = "X" Then
        k = k + 1
        Dest(k, 1) = Acc(i, 1)
        Dest(k, 2) = Grp(1, j)
      End If
    Next
  Next

  With ShList.UsedRange.Resize(, 2)
    .ClearContents
    .Rows(1) = Array("Account", "Group")
    If k > 0 Then
      .Offset(1).Resize(k).Value = Dest()
    End If
  End With

End Sub

The result:

Wb1.xlsb
	A	B
1	Account	Group
2	XX1	Group 1
3	XX1	Group 2
4	XX1	Group 5
5	XX1	Group 6
6	XX1	Group 7
7	XX1	Group 8
8	XX1	Group 9
9	XX2	Group 1
10	XX2	Group 2
11	XX2	Group 5
12	XX2	Group 6
13	XX2	Group 7
14	XX2	Group 8
15	XX2	Group 9
16	XX3	Group 1
17	XX3	Group 3
18	XX3	Group 5
19	XX3	Group 6
20	XX3	Group 8
21	XX3	Group 9
22	XX4	Group 1
23	XX4	Group 3
24	XX4	Group 5
25	XX4	Group 6
26	XX4	Group 8
27	XX4	Group 9
28	XX5	Group 1
29	XX5	Group 4
30	XX5	Group 6
31	XX5	Group 8
32	XX5	Group 9
33	XX6	Group 1
34	XX6	Group 4
35	XX6	Group 6
36	XX6	Group 8
37	XX6	Group 9
38	XX7	Group 1
39	XX7	Group 4
40	XX7	Group 6
41	XX7	Group 8
42	XX8	Group 1
43	XX8	Group 4
44	XX8	Group 6
45	XX8	Group 8
46	XX9	Group 1
47	XX9	Group 4
48	XX9	Group 6
49	XX9	Group 8
50	XX10	Group 1
51	XX10	Group 4
52	XX10	Group 6
53	XX10	Group 8
Sheet2

 

[ItalianPlatinum]

apologies here is my 2nd tab how I have it. I will try the above as well. Apologize again if it requires tweaking after seeing my below 2nd sheet

Book1
	A	B	C	D	E	F	G	H
1	Add or Remve	Group #	Account #
2	A	10000	XX1
3	A	10000	XX2
4	A	10000	XX3
5	A	10000	XX4
6	A	10000	XX5
7	A	10000	XX6
8	A	10000	XX7
9	A	10000	XX8
10	A	10000	XX9
11	A	10000	XX10
ImportExport

 

[ItalianPlatinum]

Column A ends up being unique #s that define the account for my example I just had them increase by +1 but they are actually 11 digit #s that are all unique and no correlation between each other

 

[ZVI]

Well, try this code:

Option Explicit
' Put this code into VBA module of the ImportExport sheet

Private Sub Worksheet_Activate()
  
  Const DataCell = "O7"
  Dim ShTable As Worksheet, ShList As Worksheet
  Dim Rng As Range
  Dim Acc() As Variant, Grp() As Variant, Data() As Variant, Dest() As Variant
  Dim i As Long, j As Long, k As Long
  
  Set ShTable = Sheets("Grid")
  Set ShList = Me  ' = Sheets("ImportExport")
  
  With ShTable.Range("A1").CurrentRegion
    Set Rng = .Range(DataCell).Resize(.Rows.Count - .Range(DataCell).Row + 1, .Columns.Count - .Range(DataCell).Column + 1)
    Acc() = Rng.EntireRow.Columns(4).Value
    Grp() = Rng.Offset(-1).Value
    Data() = Rng.Value
  End With
  
  ReDim Dest(1 To UBound(Data) * UBound(Data, 2), 1 To 2)
  For i = 1 To UBound(Data, 2)
    For j = 1 To UBound(Data)
      If Data(j, i) = "X" Then
        k = k + 1
        Dest(k, 1) = Grp(1, i)
        Dest(k, 2) = Acc(j, 1)
      End If
    Next
  Next
  
  With ShList.UsedRange.Resize(, 3)
    Application.ScreenUpdating = False
    .ClearContents
    .Rows(1) = Array("Add or Remove", "Group #", "Account #")
    If k > 0 Then
      .Resize(k, 1).Offset(1).Value = "A"
      .Resize(k, 2).Offset(1, 1).Value = Dest()
    End If
    Application.ScreenUpdating = True
  End With

End Sub

 

[ItalianPlatinum]

got this error Vlad.

 

[ZVI]

got this error Vlad.

Code should not go to standard module (VBE-Insert-Module).
It was highlighted in the comment - "Put this code into VBA module of the ImportExport sheet".
That means - copy the code, do right click on ImportExport sheet tab, choose "View code" and paste the code.

 

[ItalianPlatinum]

I thought I did that other than assign it to a button on that sheet. Should I not do that?