Create Smaller Tables From Larger Source Data Table - VBA

[seattletimebandit]

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:

[Cell B2]	322-H7	323-H7	324-G8	325-C11	326-E10	327-E10
Benzene	0.00829 U	0.00717 U	0.00806 U	0.0077 U	0.0082 U	0.00797 U
Toluene	0.0237 U	0.0205 U	0.0231 U	0.022 U	0.0235 U	0.0228 U
Ethylbenzene	0.0297 U	0.0257 U	0.0288 U	0.0276 U	0.0293 U	0.0285 U
mp-Xylene	0.0593 U	0.0513 U	0.0577 U	0.0551 U	0.0587 U	0.0571 U
o-Xylene	0.0297 U	0.0257 U	0.0288 U	0.0276 U	0.0293 U	0.0285 U
Gasoline	5.93 U	5.13 U	5.77 U	5.51 U	5.87 U	5.71 U

<tbody>
</tbody>

Smaller tables output, can start one row down from source table for spacing(Note the column header moves to the left in Column B):

322-H7
Benzene	0.00829 U
Toluene	0.0237 U
Ethylbenzene	0.0297 U
mp-Xylene	0.0593 U
o-Xylene	0.0297 U
Gasoline	5.93 U

<tbody>
</tbody>

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

 

[MickG]

Try this:-

[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

 

[seattletimebandit]

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):

	322-H7	323-H7	324-G8	325-C11	326-E10	327-E10
Benzene	0.00829 U	0.00717 U	0.00806 U	0.0077 U	0.0082 U	0.00797 U
Toluene	0.0237 U	0.0205 U	0.0231 U	0.022 U	0.0235 U	0.0228 U
322-H7		0.0257 U	0.0288 U	0.0276 U	0.0293 U	0.0285 U
Benzene	0.00829 U	0.0513 U	0.0577 U	0.0551 U	0.0587 U	0.0571 U
o-Xylene	0.0297 U	0.0257 U	0.0288 U	0.0276 U	0.0293 U	0.0285 U
323-H7		5.13 U	5.77 U	5.51 U	5.87 U	5.71 U
Benzene	0.00717 U
324-G8
Benzene	0.00806 U
325-C11
Benzene	0.0077 U
326-E10
Benzene	0.0082 U
327-E10
Benzene	0.00797 U

<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>
</tbody>

 

[MickG]

My fault really , Try putting any value in "B2" and then run the code again.

 

[seattletimebandit]

That worked. I was playing with it and nearly got there myself. Once again, sir, many thanks!

 

[MickG]

You're welcome

 

[seattletimebandit]

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.

 

[MickG]

Try this:-

[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

 

[seattletimebandit]

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

 

[MickG]

Please you have it working
Regrds Mick