Convert Matrix to Table

[mikeymay]

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

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

 

[Rick Rothstein]

You should be able to use something like this to convert your data to tables (modify as needed)...

[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]

Thanks Rick

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

 

[mikeymay]

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]

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]

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