Convert Matrix to Table

mikeymay

Well-known Member
Joined
Jan 17, 2006
Messages
1,467
I have a martrix of data that contains the following

Col A - Project
Col B - Role
Col C to JH - Dates from 1st Jan to 31st Dec

In each cell there will be a number or text to reflect the number of hours worked of whether it is a holiday date

Currently I have about half of the matrix with values added for about 40 rows of Projects and Roles and the code I am using to convert to a table is taking around 2 minutes. This process needs to be completed for a 2nd table so in total it is taking around 4 minutes to convert to a table.

The code I am using is below
Code:
Private Sub RefreshTables()

Dim wsSheet As Worksheet

Dim rngData As Range
Dim rngDataTable As Range

Dim strClient As String
Dim strRole As String

Dim lngRow As Long
Dim lngTableRow As Long
Dim lngCol As Long

Set wsSheet = Sheets(strSheet)

wsSheet.Unprotect Password:=strPassword

'Clear tbl_Demand
With wsSheet.ListObjects("tbl_" & strSheet)
   If Not .DataBodyRange Is Nothing Then
      .DataBodyRange.Delete
      Else
   End If
End With

'Where table data will go
Set rngDataTable = wsSheet.Range(strSheet & "_TableStart").Offset(1, 0)

'reset rows
lngRow = 0
lngTableRow = 0

With wsSheet
   'Added data
   Set rngData = .Range(strSheet & "_Start").Offset(1, 0)
   
   'Go through all rows in demand data
   Do Until rngData.Offset(lngRow, 0).Row = .Range(strSheet & "_End").Row
      'if the Project is blank then skip
      If rngData.Offset(lngRow, 0) = "" Or rngData.Offset(lngRow, 1) = "" Then
         Else
         'get the project & client
         strClient = rngData.Offset(lngRow, 0)
         strRole = rngData.Offset(lngRow, 1)
         
         'Set 1st column of date
         lngCol = 2
      
         'Go through all the columns in the row
         Do Until rngData.Offset(-1, lngCol) = ""
            Application.StatusBar = "Row " & lngRow & "   " & Format(rngData.Offset(-1, lngCol), "d mmm")
            'if a number added get the details and add to the tbl
            If IsNumeric(rngData.Offset(lngRow, lngCol)) And rngData.Offset(lngRow, lngCol) > 0 Then
               rngDataTable.Offset(lngTableRow, 0) = strClient
               rngSummary = strClient
               rngDataTable.Offset(lngTableRow, 1) = strRole
               rngSummary.Offset(0, 1) = strRole
               rngDataTable.Offset(lngTableRow, 2) = rngData.Offset(-1, lngCol) 'Date
               rngSummary.Offset(0, 2) = rngData.Offset(-1, lngCol)
               rngDataTable.Offset(lngTableRow, 3) = rngData.Offset(lngRow, lngCol) ' Demand FTE
                              
               If strSheet = "Assigned" Then
                  rngDataTable.Offset(lngTableRow, 4) = rngData.Offset(lngRow, -1) ' Name
                  Else
               End If
               
               Set rngSummary = rngSummary.Offset(1, 0)
               
               lngTableRow = lngTableRow + 1
               Else
            End If
            
            'Next col
            lngCol = lngCol + 1
         Loop
      End If
      
      'Next row
      lngRow = lngRow + 1
   Loop
End With

Application.StatusBar = ""

Set rngDataTable = Nothing
Set rngData = Nothing

wsSheet.Protect Password:=strPassword

Set wsSheet = Nothing

End Sub
What I need to do is find a quicker way of converting the data as 4+ minutes isn't viable.


Thanks
 

Some videos you may like

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
36,400
Office Version
  1. 2010
Platform
  1. Windows
You should be able to use something like this to convert your data to tables (modify as needed)...
Code:
[table="width: 500"]
[tr]
	[td]Sub MakeTable()
  Dim LastRow As Long
  LastRow = Columns("A:JH").Find("*", , xlValues, , xlRows, xlPrevious, , , False).Row
  ActiveSheet.ListObjects.Add(xlSrcRange, Range("A1:JH" & LastRow), , xlYes).Name = "Table1"
End Sub[/td]
[/tr]
[/table]
 

mikeymay

Well-known Member
Joined
Jan 17, 2006
Messages
1,467
Thanks Rick

Would that convert the data to 3 columns (Project, Role & hours)?
 

mikeymay

Well-known Member
Joined
Jan 17, 2006
Messages
1,467
Just tried that and it converts the original data to a table but I need to keep the format and have the data placed elsewhere as a 3 column table.
 

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
36,400
Office Version
  1. 2010
Platform
  1. Windows
Just tried that and it converts the original data to a table but I need to keep the format and have the data placed elsewhere as a 3 column table.
You have 268 columns now... what would your 3 column table look like?
 

mikeymay

Well-known Member
Joined
Jan 17, 2006
Messages
1,467
Currently it's
A - Project
B - Role
C to JH - Hours for each row for dates 1st Jan to 31st Dec

It needs to be

A - Project
B - Role
C - Date
D - Hours
 

Watch MrExcel Video

Forum statistics

Threads
1,112,818
Messages
5,542,677
Members
410,568
Latest member
jmagasan
Top