Format each group of three columns as Tables

apurcell

New Member
Joined
Jan 14, 2020
Messages
13
Office Version
  1. 365
Platform
  1. Windows
Hello All,
I currently have a workbook with 3 sheets
Sheet 1: I use the =FILTER() Function to filter the data into only 3 columns for better presentation. Each set of data (the three columns) is presented in Cells A7:C100, D7:G100. I7:K100 etc. The last set is on GK7:GM100.
Sheet 2: Is the logic for how I would like to break out the data
Sheet 3: is all of the Data
I would like to create a MACRO that would take Sheet 1, create a duplicate, copy/paste as values (to remove the formulas) and then format each of these ranges (A7:C100, D7:G100. I7:K100 etc.) into Individual tables for further filtering if required.
Please let me know if this is possible!
Thank you so much :)
 

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying
When You Use filter, Hide Entire row of Unwanted Data. Then if you want Filter One Table with, Other Tables with same Row but Different Column, will be effected.
 
Upvote 0
When You Use filter, Hide Entire row of Unwanted Data. Then if you want Filter One Table with, Other Tables with same Row but Different Column, will be effected.
Yes I didn't think about that. What if instead it is a macro to split each table into its own sheet?
 
Upvote 0
I think you can Create Index Sheet to Link Tables. And it is better to transfer tables to each 100 rows.
Table 2 form row 107 to 200
Table 3 from row 207 to 300 And ...
Or transfer to sheets also.
Both of them Possible.
 
Upvote 0
Try This:
VBA Code:
Sub TransformData()
Dim i As Long, Lr As Long, j As Long, Cell As Range, Lc As Long, L As Long, K1 As Long
Dim Lr2 As Long, Sh1 As Worksheet, Sh2 As Worksheet, Ws As Worksheet, LinkName As String
Dim IndexSH As String, LinkName2 As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    
    'Create an Index Sheet. If already existing, clear it.
    On Error Resume Next
    Set Ws = Worksheets("Index")
    If Err.Number = 0 Then
        Worksheets("Index").ClearContents
        Else
        On Error GoTo 0
        Worksheets.Add(Before:=Worksheets(1)).Name = "Index"
    End If
    Worksheets("Index").Activate
    Range("A1") = "Index"
    Range("A1").Font.Bold = True
    Range("A1").Font.Size = 20
    
Set Sh1 = Sheets("Sheet1")
Set Sh2 = Sheets("Sheet2")
Lc = Sh1.Cells(7, Columns.Count).End(xlToLeft).Column
IndexSH = "Index!A1"
For j = 1 To Lc Step 3
Range(Sh2.Cells(Int(j / 3) * 100 + 7, 1), Sh2.Cells((Int(j / 3) + 1) * 100, 3)).Value = Range(Sh1.Cells(7, j), Sh1.Cells(100, j + 2)).Value
Sh2.ListObjects.Add(xlSrcRange, Sh2.Range(Sh2.Cells(Int(j / 3) * 100 + 7, 1), Sh2.Cells((Int(j / 3) + 1) * 100, 3)), , xlYes).Name = "Table" & Int(j / 3) + 1
Sh2.ListObjects("Table" & Int(j / 3) + 1).TableStyle = "TableStyleLight1"
LinkName = "Sheet2!A" & Int(j / 3) * 100 + 7
Set LinkName2 = Range("Sheet2!E" & Int(j / 3) * 100 + 7)
Worksheets("Index").Range("A" & Int(j / 3) + 2).Value = "Table" & Int(j / 3) + 1
Ws.Hyperlinks.Add Anchor:=Range("A" & Int(j / 3) + 2), Address:="", SubAddress:=LinkName, TextToDisplay:="Table" & Int(j / 3) + 1
Sh2.Hyperlinks.Add Anchor:=LinkName2, Address:="", SubAddress:=IndexSH, TextToDisplay:="INDEX Sheet"
Next j

Worksheets("Index").Columns(1).AutoFit
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,886
Messages
6,175,191
Members
452,616
Latest member
intern444

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