Excel TABLE - VBA to move cell from one table to another

giantg

New Member
Joined
Jun 28, 2019
Messages
9
New to VBA and trying to piece together a macro but the table part is causing me problems.

I have multiple "3 or 4 column" tables on a worksheet. I want to move a cell value by Double Clicking the cell on one table, then click anywhere on another table to move that cell value to that table. When the value moves, needs to remove blanks and sort.

I need the table columns to be sorted as if they were all stacked in one column, then split back to three (or four depending on how many columns are in the table).

Any help is appreciated. Please let me know if you need more details.
 

Some videos you may like

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,319
Office Version
365
Platform
Windows
trying to understand exactly what you want :confused:
Is it this?

start with ...

Excel 2016 (Windows) 32 bit
A
B
C
D
1
ColAColBColCColD
2
A001B001C001A005
3
A002C002A006
4
A003B003C003
5
A004B004C004A008
6
7
8
9
10
11
ColAColBColCColD
12
A040B040C040A040
13
A041B041C041A041
14
A042B042C042A042
Sheet: Before

move cell and move other cells down ...

Excel 2016 (Windows) 32 bit
A
B
C
D
1
ColAColBColCColD
2
A001B001C001A005
3
A002C002A006
4
A003B003C003
5
A004C041C004A008
6
B004
7
8
9
10
11
ColAColBColCColD
12
A040B040C040A040
13
A041B041A041
14
A042B042C042A042
Sheet: AfterMove

and sort - Table 1 sorted , Table2 unsorted

Excel 2016 (Windows) 32 bit
A
B
C
D
1
ColAColBColCColD
2
A001A005B003C003
3
A002A006B004C004
4
A003A008C001C041
5
A004B001C002
6
7
8
9
10
ColAColBColCColD
11
A040B040C040A040
12
A041B041A041
13
A042B042C042A042
Sheet: AfterSort
 

giantg

New Member
Joined
Jun 28, 2019
Messages
9
Imagine they are bins. Three or Four columns wide in order to avoid long columns. Then moving items from one bin to another and sorting them entire bin... removing blanks and potentially unused rows. The bins are from left to right (columns A,B,C....F,G,H...K,L,M...etc). I can draw an example today when I get to my desk. Thanks for helping.
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,319
Office Version
365
Platform
Windows
1. Are there headers in row 1 ?

Imagine they are bins. Three or Four columns wide in order to avoid long columns
2. Which is the last permitted row number ?
 

giantg

New Member
Joined
Jun 28, 2019
Messages
9
1. Are there headers in row 1 ?
Yes, the headers are Acol1, Acol2 Acol3...Bcol1, Bcol2, Bcol3... etc. I will have a button stretched over the headers to label the group "A", "B", etc.


2. Which is the last permitted row number ?
No limit, the table row length will grow or shrink depending on the number of used cells. Ex: 100 cells used in table of 3 columns, then 100/3 = 34 rows... move a cell out, then 99/3 = 33 rows.
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,319
Office Version
365
Platform
Windows
so when does it become 4 columns ?
 

giantg

New Member
Joined
Jun 28, 2019
Messages
9
Some are three, some are four (as there will be a higher volume in one table than others). If necessary, I can have all as three columns to start.
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,319
Office Version
365
Platform
Windows
Thanks
- will post code tomorrow
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,319
Office Version
365
Platform
Windows
Before (1)

Excel 2016 (Windows) 32 bit
K
L
M
N
O
P
Q
R
S
1
Header1Header2Header3Header4Header1Header2Header3Header4
2
14​
143​
277​
8​
319​
636​
3
94​
149​
426​
8​
320​
642​
4
98​
666​
582​
9​
332​
645​
5
126​
220​
645​
9​
336​
657​
6
11​
340​
677​
7
11​
347​
681​
8
11​
355​
683​
9
22​
370​
746​
10
23​
374​
747​
11
23​
374​
748​
12
31​
374​
749​
13
51​
375​
762​
14
54​
380​
766​
15
55​
386​
772​
16
56​
494​
780​
17
64​
497​
782​
18
66​
510​
782​
19
66​
513​
797​
20
110​
544​
802​
21
122​
552​
804​
22
123​
568​
810​
23
135​
575​
810​
24
166​
578​
811​
25
247​
580​
820​
26
250​
581​
832​
27
263​
591​
836​
28
292​
592​
845​
29
295​
599​
845​
30
300​
601​
847​
31
305​
605​
849​
32
318​
620​
851​
33
318​
623​
854​
34
319​
629​
925​
35
Sheet: Tables

After (1)


Excel 2016 (Windows) 32 bit
K
L
M
N
O
P
Q
R
S
1
Header1Header2Header3Header4Header1Header2Header3Header4
2
14​
143​
426​
8​
263​
513​
747​
3
94​
149​
582​
8​
292​
544​
748​
4
98​
220​
645​
9​
295​
552​
749​
5
126​
277​
9​
300​
568​
762​
6
11​
305​
575​
766​
7
11​
318​
578​
772​
8
11​
318​
580​
780​
9
22​
319​
581​
782​
10
23​
319​
591​
782​
11
23​
320​
592​
797​
12
31​
332​
599​
802​
13
51​
336​
601​
804​
14
54​
340​
605​
810​
15
55​
347​
620​
810​
16
56​
355​
623​
811​
17
64​
370​
629​
820​
18
66​
374​
636​
832​
19
66​
374​
642​
836​
20
110​
374​
645​
845​
21
122​
375​
657​
845​
22
123​
380​
666​
847​
23
135​
386​
677​
849​
24
166​
494​
681​
851​
25
247​
497​
683​
854​
26
250​
510​
746​
925​
27
Sheet: Tables


Before (2)

Excel 2016 (Windows) 32 bit
F
G
H
I
J
K
L
M
N
1
Header1Header2Header3Header4Header1Header2Header3Header4
2
14​
151​
677​
14​
143​
426​
3
94​
166​
681​
94​
149​
582​
4
98​
220​
683​
98​
220​
645​
5
126​
277​
811​
126​
277​
6
143​
426​
925​
7
149​
645​
974​
8
Sheet: Tables

After (2)

Excel 2016 (Windows) 32 bit
F
G
H
I
J
K
L
M
N
1
Header1Header2Header3Header4Header1Header2Header3Header4
2
14​
151​
677​
14​
143​
426​
3
94​
166​
681​
94​
149​
582​
4
98​
220​
811​
98​
220​
645​
5
126​
277​
925​
126​
277​
683​
6
143​
426​
974​
7
149​
645​
8
Sheet: Tables


Code:
Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim Table2 As Range, cel As Range, ws As Worksheet, Bin1 As Range, Bin2 As Range
    If Target.CountLarge > 1 Or Target.Row = 1 Then Exit Sub
    Cancel = True
'which bin ?
    On Error Resume Next
        Set Bin2 = Application.InputBox("Click on other table and click OK", "Move a value to another bin", , , , , , 8)
    On Error GoTo 0
    If Err.Number > 0 Or Bin2.Column Mod 5 = 0 Then Exit Sub
'bin ranges
    Set Bin2 = GetBin(Bin2)
    Set Bin1 = GetBin(Target)

    Call MoveAndSort(Bin2, Target)
    Call MoveAndSort(Bin1)

End Sub
Code:
Private Function GetBin(cell As Range) As Range
    Set GetBin = Cells(2, cell.Column).Offset(, 1 - (cell.Column Mod 5)).Resize(1000, 4)
End Function

Private Sub MoveAndSort(Bin As Range, Optional cell As Range)
    Application.ScreenUpdating = False
    Dim ws As Worksheet, Itm As Range
    Dim itmCount As Long, colCount As Long, rowCount As Long, itmRow As Long, r As Long, c As Long
[COLOR=#006400]'sort in temp sheet[/COLOR]
    Set ws = Sheets.Add
    If Not cell Is Nothing Then
        ws.Cells(1, 1) = cell
        cell.ClearContents
    End If
    For Each Itm In Bin
        If Not Itm = "" Then ws.Cells(Rows.Count, 1).End(xlUp).Offset(1) = Itm
    Next Itm
[COLOR=#006400]'sort the data and clear bin[/COLOR]
    ws.Columns("A").Sort key1:=ws.Range("A1"), order1:=xlAscending, Header:=xlNo
    Bin.ClearContents
    itmCount = ws.Cells(Rows.Count, 1).End(xlUp).Row
[COLOR=#006400]'determine number of columns and rows[/COLOR]
    If itmCount > [COLOR=#ff0000]99[/COLOR] Then colCount = 4 Else colCount = 3
    rowCount = (itmCount - itmCount Mod colCount) / colCount
    If itmCount Mod colCount > 0 Then rowCount = rowCount + 1
[COLOR=#006400]'write back to bin[/COLOR]
    For c = 0 To colCount - 1
        For r = 0 To rowCount - 1
            itmRow = itmRow + 1
            Bin.Cells(1, 1).Offset(r, c) = ws.Cells(itmRow, 1)
        Next r
    Next c
[COLOR=#006400]'tidy up[/COLOR]
    Application.DisplayAlerts = False:  ws.Delete:  Application.DisplayAlerts = True
End Sub
NOTES
- the number of columns increases from 3 to 4 if the number of items exceeds 99
- place all the code in the SHEET module
- double-click on "value to move" and click "any cell in other bin" and click OK
- ensure double-click inside the cell (NOT on cell border)
- test exactly as posted before amending anything
 

giantg

New Member
Joined
Jun 28, 2019
Messages
9
Thanks. I'll test it out today and let you know if it works as planned. Thanks for the help!
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,101,988
Messages
5,484,049
Members
407,426
Latest member
Owen Chia

This Week's Hot Topics

  • Finding issue in If elseif else with For each Loop
    Finding issue in If elseif else with For each Loop I have tried this below code but i'm getting in Y column filled with W005. Colud you please...
  • MsgBox Error
    Hi Guys, I have the below error show up when i try and run my macro in File1 but works fine if i copy and paste the same code into file2. [ATTACH...
  • CELL FORMAT - IF CONDITION
    My Cell Format is [B]""0.00" Cr". [/B]But in the cell, it is showing 123.00 for editing. (123 is entry figure). (Data imported from other...
  • Show numbers nearly the same
    Is this possible. I have a number that can change very time eg 0.00001234 Then I have a lot of numbers 0.0000001, 0.0000002, 0.00000004...
  • Please i need your help to create formula
    I need a formula in cell B8 to do this >>if b1=1 then multiply ( cell b8) by 10% ,if b1=2 multiply by 20%,if=3 multiply by 30%. Thank you in...
  • Got error while adding column and filter
    Got error while adding column and filter In column Z has some like "Success" and "Error". I want to add column in AA if the Z cell value is...
Top