Create Smaller Tables From Larger Source Data Table - VBA

S

seattletimebandit

Board Regular
Joined
Apr 11, 2013
Messages
69
Hello!

Trying to figure out how to take a table of data and split into individual smaller tables. The source data table columns and rows are variable, from a few columns/rows to quite a lot, so maybe a message box asking user to select Range?

or something like:

Dim c1 As Range
Dim c2 As Range
lastColumn = ActiveSheet.Cells(c1.Row, Columns.Count).End(xlToLeft).Column
For Each c2 In Range(Cells(c1.Row, 3), Cells(c1.Row, lastColumn)).

Start with User pasting the Source Data Table starting in Cell B2 (which is empty):

Source Data Table:
[TABLE="class: grid, width: 669"]
<tbody>[TR]
[TD] [Cell B2][/TD]
[TD]322-H7[/TD]
[TD]323-H7[/TD]
[TD]324-G8[/TD]
[TD]325-C11[/TD]
[TD]326-E10[/TD]
[TD]327-E10[/TD]
[/TR]
[TR]
[TD]Benzene[/TD]
[TD]0.00829 U[/TD]
[TD]0.00717 U[/TD]
[TD]0.00806 U[/TD]
[TD]0.0077 U[/TD]
[TD]0.0082 U[/TD]
[TD]0.00797 U[/TD]
[/TR]
[TR]
[TD]Toluene[/TD]
[TD]0.0237 U[/TD]
[TD]0.0205 U[/TD]
[TD]0.0231 U[/TD]
[TD]0.022 U[/TD]
[TD]0.0235 U[/TD]
[TD]0.0228 U[/TD]
[/TR]
[TR]
[TD]Ethylbenzene[/TD]
[TD]0.0297 U[/TD]
[TD]0.0257 U[/TD]
[TD]0.0288 U[/TD]
[TD]0.0276 U[/TD]
[TD]0.0293 U[/TD]
[TD]0.0285 U[/TD]
[/TR]
[TR]
[TD]mp-Xylene[/TD]
[TD]0.0593 U[/TD]
[TD]0.0513 U[/TD]
[TD]0.0577 U[/TD]
[TD]0.0551 U[/TD]
[TD]0.0587 U[/TD]
[TD]0.0571 U[/TD]
[/TR]
[TR]
[TD]o-Xylene[/TD]
[TD]0.0297 U[/TD]
[TD]0.0257 U[/TD]
[TD]0.0288 U[/TD]
[TD]0.0276 U[/TD]
[TD]0.0293 U[/TD]
[TD]0.0285 U[/TD]
[/TR]
[TR]
[TD]Gasoline[/TD]
[TD]5.93 U[/TD]
[TD]5.13 U[/TD]
[TD]5.77 U[/TD]
[TD]5.51 U[/TD]
[TD]5.87 U[/TD]
[TD]5.71 U[/TD]
[/TR]
</tbody>[/TABLE]

Smaller tables output, can start one row down from source table for spacing(Note the column header moves to the left in Column B):
[TABLE="class: grid, width: 204"]
<tbody>[TR]
[TD]322-H7[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Benzene[/TD]
[TD]0.00829 U[/TD]
[/TR]
[TR]
[TD]Toluene[/TD]
[TD]0.0237 U[/TD]
[/TR]
[TR]
[TD]Ethylbenzene[/TD]
[TD]0.0297 U[/TD]
[/TR]
[TR]
[TD]mp-Xylene[/TD]
[TD]0.0593 U[/TD]
[/TR]
[TR]
[TD]o-Xylene[/TD]
[TD]0.0297 U[/TD]
[/TR]
[TR]
[TD]Gasoline[/TD]
[TD]5.93 U[/TD]
[/TR]
</tbody>[/TABLE]




and so on..until entire Source Data Table has been split up.

Thoughts? Scripting.Dictionary? Not well versed in that complex coding, but have seen it work well on something similar, I just can get my head around tweaking the code I have to apply here.

Thanks! Russell
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Sort by date Sort by votes
Try this:-
Code: 
[COLOR="Navy"]Sub[/COLOR] MG09Oct26
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Rw [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Lst = Cells("2", Columns.Count).End(xlToLeft).Column - 2
[COLOR="Navy"]Set[/COLOR] Rng = Range("B2", Range("B2").End(xlDown))
[COLOR="Navy"]For[/COLOR] Ac = 1 To Lst
    Rw = Rw + Rng.Count + 1
    Rng.Offset(Rw).Resize(Rng.Count) = Rng.Value
    Rng.Offset(Rw, 1).Resize(Rng.Count) = Rng.Offset(, Ac).Value
    Rng(1).Offset(Rw, 1).Cut Rng(1).Offset(Rw)
[COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
MickG,

Thanks for the quick response. You were the one who once helped with me a Transposing data table that used the Scripting.Dictionary back in Feb 2017. Still using it today, thanks for that.

For this current bit of code, the output looks like this (not sure if I'm doing something wrong here):





<colgroup><col style="mso-width-source:userset;mso-width-alt:2486; width:51pt" width="68" span="6"> <col style="width:48pt" width="64"> </colgroup><tbody>
[TD="class: xl68, width: 68"] [/TD]
[TD="class: xl66, width: 68"]322-H7[/TD]
[TD="class: xl66, width: 68"]323-H7[/TD]
[TD="class: xl66, width: 68"]324-G8[/TD]
[TD="class: xl66, width: 68"]325-C11[/TD]
[TD="class: xl66, width: 68"]326-E10[/TD]
[TD="class: xl66, width: 64"]327-E10[/TD]

[TD="class: xl67"]Benzene[/TD]
[TD="class: xl66"]0.00829 U[/TD]
[TD="class: xl66"]0.00717 U[/TD]
[TD="class: xl66"]0.00806 U[/TD]
[TD="class: xl66"]0.0077 U[/TD]
[TD="class: xl66"]0.0082 U[/TD]
[TD="class: xl66"]0.00797 U[/TD]

[TD="class: xl67"]Toluene[/TD]
[TD="class: xl66"]0.0237 U[/TD]
[TD="class: xl66"]0.0205 U[/TD]
[TD="class: xl66"]0.0231 U[/TD]
[TD="class: xl66"]0.022 U[/TD]
[TD="class: xl66"]0.0235 U[/TD]
[TD="class: xl66"]0.0228 U[/TD]

[TD="class: xl66"]322-H7[/TD]
[TD="class: xl65"][/TD]
[TD="class: xl66"]0.0257 U[/TD]
[TD="class: xl66"]0.0288 U[/TD]
[TD="class: xl66"]0.0276 U[/TD]
[TD="class: xl66"]0.0293 U[/TD]
[TD="class: xl66"]0.0285 U[/TD]

[TD="class: xl67"]Benzene[/TD]
[TD="class: xl66"]0.00829 U[/TD]
[TD="class: xl66"]0.0513 U[/TD]
[TD="class: xl66"]0.0577 U[/TD]
[TD="class: xl66"]0.0551 U[/TD]
[TD="class: xl66"]0.0587 U[/TD]
[TD="class: xl66"]0.0571 U[/TD]

[TD="class: xl67"]o-Xylene[/TD]
[TD="class: xl66"]0.0297 U[/TD]
[TD="class: xl66"]0.0257 U[/TD]
[TD="class: xl66"]0.0288 U[/TD]
[TD="class: xl66"]0.0276 U[/TD]
[TD="class: xl66"]0.0293 U[/TD]
[TD="class: xl66"]0.0285 U[/TD]

[TD="class: xl66"]323-H7[/TD]
[TD="class: xl65"][/TD]
[TD="class: xl66"]5.13 U[/TD]
[TD="class: xl66"]5.77 U[/TD]
[TD="class: xl66"]5.51 U[/TD]
[TD="class: xl66"]5.87 U[/TD]
[TD="class: xl66"]5.71 U[/TD]

[TD="class: xl65"]Benzene[/TD]
[TD="class: xl65"]0.00717 U[/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]

[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]

[TD="class: xl65"]324-G8[/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]

[TD="class: xl65"]Benzene[/TD]
[TD="class: xl65"]0.00806 U[/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]

[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]

[TD="class: xl65"]325-C11[/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]

[TD="class: xl65"]Benzene[/TD]
[TD="class: xl65"]0.0077 U[/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]

[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]

[TD="class: xl65"]326-E10[/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]

[TD="class: xl65"]Benzene[/TD]
[TD="class: xl65"]0.0082 U[/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]

[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]

[TD="class: xl65"]327-E10[/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]

[TD="class: xl65"]Benzene[/TD]
[TD="class: xl65"]0.00797 U[/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]

</tbody>
 
Last edited:
Upvote 0
MickG,

Is it possible to put borders around each of those output tables as the tables are generated from the source table? But the challenge is that I don't need a full grid, but a full border around table, all inside vertical lines, one horizontal border at the bottom of top row only, and the number of rows and columns is variable, but there is always a single top row with this border format (no inside vertical lines).

I've been trying to attach an image as an example, but getting mired in how to do that.

If that's not possible, then maybe a macro that prompts the user to select each output table and add borders with the above format?

OR

After the output tables area generated down the spreadsheet, each separated by an empty row, could borders be added by selecting ALL the output tables as one range and adding borders as above format? w/o adding any vertical borders in the empty rows?

Am I making sense? If I can figure out how to attach an image, it'll be clear as to my border format.

Again thanks for your help, a big time-saver thus far.
 
Upvote 0
Try this:-
Code: 
[COLOR="Navy"]Sub[/COLOR] MG14Oct13
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Rw [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Lst = Cells("2", Columns.Count).End(xlToLeft).Column - 2
[COLOR="Navy"]Set[/COLOR] Rng = Range("B2", Range("B2").End(xlDown))

[COLOR="Navy"]For[/COLOR] Ac = 1 To Lst
    Rw = Rw + Rng.Count + 1
    Rng.Offset(Rw).Resize(Rng.Count) = Rng.Value
    Rng.Offset(Rw + 1).Resize(Rng.Count - 1).BorderAround Weight:=xlThick
    Rng.Offset(Rw)(1).Resize(, 2).BorderAround Weight:=xlThick
    
    Rng.Offset(Rw, 1).Resize(Rng.Count) = Rng.Offset(, Ac).Value
    Rng.Offset(Rw + 1, 1).Resize(Rng.Count - 1).BorderAround Weight:=xlThick
    Rng(1).Offset(Rw) = Rng(1).Offset(Rw, 1)
    Rng(1).Offset(Rw, 1) = ""

[COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
MickG-

As always, stellar. Works as planned!

I may come to you for more tweaks, if that's okay.

I am creating these little tables that are used to present data in AutoCAD. They represent lab data from soil and groundwater sampling.

First they are created in Excel, then a decades old (Excel 3.0) Add-in is used to convert them objects that can be imported into AutoCAD as blocks, then placed appropriately around the drawing (Google Earth map of a subject property).

We have been doing these by hand for years, but since I've been taking time to learn VBA (slowly, I might add), coming to Mr. Excel has been a savior. Thanks to you and others who have helped me.

Again, very much appreciated!

-Russell
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
Splitting data in cells w/VBA macro
Replies
2
Views
712
seattletimebandit
S
L
  • Question Question
VBA - Help with Copy/Paste from Source Workbook to Create Multiple Rows in Active Workbook
Replies
2
Views
283
Luannilow
L
S
  • Question Question
Data Extraction from a single large table with formulae or VBA (VLOOKUP? MATCH? INDEX)
2
Replies
11
Views
2K
Aladin Akyurek
Aladin Akyurek
S
  • Question Question
Transpose data as an array in vba
2 3
Replies
25
Views
7K
seattletimebandit
S

Forum statistics

Threads
1,223,903
Messages
6,175,284
Members
452,630
Latest member
OdubiYouth

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top