PDA

View Full Version : Array only returning first column of values



Lwebzer
11-19-2019, 02:06 PM
Hey Everyone,

I know I've been posting a bunch recently so please just let me know if I'm going against the rules. You all are awesome and I wouldn't be able to make much progress in learning VBA without your help.

The below code is only returning the first column of the values in the data I'm trying to list out. Can anyone point out where I'm going wrong? I'd like to be able to do this in a dynamic, scalable way - so don't want to list out all the possible values for the array column. This could change. I also don't really understand why this is necessary. :(

Thank you so much

Louis

______________________________________________


Here is the data I'm trying to convert (as an example):





Bookings
Bookings
4 Wall
4 Wall


Customer ID
7/1/2014
8/1/2014
11/1/2014
12/1/2014


1052
$ 38K
$ 31K
$ 120K
$ 29K


1105
$ -
$ -
$ 9K
$ 0K


1110
$ 25K
$ 56K
$ 37K
$ 35K


1123
$ -
$ 25K
$ -
$ 21K




_____________________________________________________

The below code returns this:



$37.58


$0.00


$24.87


$0.00


#N/A


#N/A


#N/A


#N/A


#N/A


#N/A


#N/A


#N/A


#N/A


#N/A


#N/A


#N/A



___________________________________________________

Here is my code (I bolded and underlined where I think the problem is):

Sub LG_Data_Converter()




Dim Nmbr_Headers As Byte
Nmbr_Headers = Application.InputBox("Input Required", "How many Header Rows are there?", Type:=1, Default:=2)


Dim FirstRow As Long, LastRow As Long, FirstColumn As Long, LastColumn As Long

FirstRow = Cells.Find(What:="*", After:=Range("XFD300000"), LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row


LastRow = Cells.Find(What:="*", After:=Range("XFD300000"), LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

FirstColumn = Cells.Find(What:="*", After:=Range("XFD300000"), LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext).Column

LastColumn = Cells.Find(What:="*", After:=Range("XFD300000"), LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

Dim No_Data_Rows As Long
No_Data_Rows = LastRow - FirstRow - Nmbr_Headers + 1 '(Inclusive)'

Dim No_Data_Columns As Long
No_Data_Columns = LastColumn - FirstColumn + 1 - 1 '(Take into account the customer ID column)'

Dim Dataset() As Variant
ReDim Dataset(1 To No_Data_Rows, 1 To No_Data_Columns)

Dim i As Long, j As Long


For i = 1 To No_Data_Rows
For j = 1 To No_Data_Columns


Dataset(i, j) = Cells(i, j).Offset(FirstRow + Nmbr_Headers - 1, FirstColumn + 1 - 1)


Next j
Next i

Dim Nmbr_Values As Long
Nmbr_Values = No_Data_Rows * No_Data_Columns



Cells(20, 10).Resize(Nmbr_Values).Value = Dataset














End Sub

p45cal
11-19-2019, 04:10 PM
you don't need:

Dim Nmbr_Values As Long
Nmbr_Values = No_Data_Rows * No_Data_Columns
and change this:

Cells(20, 10).Resize(Nmbr_Values ).Value = Dataset
to this:

Cells(20, 10).Resize(No_Data_Rows, No_Data_Columns).Value = Dataset

However, you'll get the same data in DataSet with:

Sub LG_Data_Converter2()
Dim Nmbr_Headers As Byte
Dim FirstRow As Long, LastRow As Long, FirstColumn As Long, LastColumn As Long
Dim No_Data_Rows As Long, No_Data_Columns As Long
Dim Dataset

Nmbr_Headers = Application.InputBox("Input Required", "How many Header Rows are there?", Type:=1, Default:=2)

FirstRow = Cells.Find(What:="*", After:=Range("XFD300000"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row
LastRow = Cells.Find(What:="*", After:=Range("XFD300000"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
FirstColumn = Cells.Find(What:="*", After:=Range("XFD300000"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext).Column
LastColumn = Cells.Find(What:="*", After:=Range("XFD300000"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

No_Data_Rows = LastRow - FirstRow - Nmbr_Headers + 1 '(Inclusive)'
No_Data_Columns = LastColumn - FirstColumn '(Take into account the customer ID column)'

Dataset = Cells(FirstRow + Nmbr_Headers, FirstColumn + 1).Resize(No_Data_Rows, No_Data_Columns)

Cells(20, 10).Resize(No_Data_Rows, No_Data_Columns).Value = Dataset
End Sub


or even:
Sub LG_Data_Converter3()
Dim Nmbr_Headers As Byte
Dim FirstRow As Long, LastRow As Long, FirstColumn As Long, LastColumn As Long
Dim Dataset

Nmbr_Headers = Application.InputBox("Input Required", "How many Header Rows are there?", Type:=1, Default:=2)

FirstRow = Cells.Find(What:="*", After:=Range("XFD300000"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row
LastRow = Cells.Find(What:="*", After:=Range("XFD300000"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
FirstColumn = Cells.Find(What:="*", After:=Range("XFD300000"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext).Column
LastColumn = Cells.Find(What:="*", After:=Range("XFD300000"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

Set myRng = Range(Cells(FirstRow, FirstColumn), Cells(LastRow, LastColumn)) 'all data incl headers
Set myRng = Intersect(myRng, myRng.Offset(Nmbr_Headers, 1)) 'just the databody

Dataset = myRng 'put the data into an array.

Cells(20, 10).Resize(UBound(Dataset, 1), UBound(Dataset, 2)).Value = Dataset 'write the array to the sheet.
End Sub

Lwebzer
11-19-2019, 04:17 PM
Thank you for the reply! I should have specified - I'm trying to stack all the values in one column, so in my case your code doesn't solve my issue. Sorry for the poor explanation and thanks for your response again.

snb
11-19-2019, 04:36 PM
see: http://www.vbaexpress.com/forum/showthread.php?66276-Data-Conversion-using-Dynamic-Multi-Dimensional-Array&p=396666#post396666

jolivanes
11-19-2019, 04:47 PM
Sub Maybe()
Dim lr As Long, lc As Long, i As Long
lr = Cells.Find("*", , , , xlByRows, xlPrevious).Row
lc = Cells.Find("*", , , , xlByColumns, xlPrevious).Column
For i = 2 To lc
Cells(Rows.Count, lc + 1).End(xlUp).Offset(1).Resize(lr - 2).Value = Range(Cells(3, i), Cells(lr, i)).Value
Next i
End Sub

Lwebzer
11-19-2019, 04:51 PM
I really appreciate your replies but it's hard for me to understand your code without an explanation. I'm sorry. :( Do you think you could explain how you are converting the values of the two dimensions and displaying them all as one dimension? I'm not ignoring your posts - I just can't understand it if you only post code. Sorry.

Lwebzer
11-19-2019, 04:51 PM
Below reply was for you - not sure if it came up.

p45cal
11-19-2019, 04:51 PM
depending on whether you want:
$ 38K
$ -
$ 25K
$ -
$ 31K
$ -
$ 56K
$ 25K
$ 120K
$ 9K
$ 37K
$ -
$ 29K
$ 0K
$ 35K
$ 21K

or:

$ 38K
$ 31K
$ 120K
$ 29K
$ -
$ -
$ 9K
$ 0K
$ 25K
$ 56K
$ 37K
$ 35K
$ -
$ 25K
$ -
$ 21K

enable/disable one of the choices in the code at either:~~or:

Sub LG_Data_Converter3()
Dim Nmbr_Headers As Byte
Dim FirstRow As Long, LastRow As Long, FirstColumn As Long, LastColumn As Long
Dim Dataset()

Nmbr_Headers = Application.InputBox("Input Required", "How many Header Rows are there?", Type:=1, Default:=2)

FirstRow = Cells.Find(What:="*", After:=Range("XFD300000"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row
LastRow = Cells.Find(What:="*", After:=Range("XFD300000"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
FirstColumn = Cells.Find(What:="*", After:=Range("XFD300000"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext).Column
LastColumn = Cells.Find(What:="*", After:=Range("XFD300000"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

Set myRng = Range(Cells(FirstRow, FirstColumn), Cells(LastRow, LastColumn)) 'all data incl headers
Set myRng = Intersect(myRng, myRng.Offset(Nmbr_Headers, 1)) 'just the databody

ReDim Dataset(1 To myRng.Cells.Count, 1 To 1)
i = 1
'then either:
For Each colm In myRng.Columns
For Each cll In colm.Cells
Dataset(i, 1) = cll
i = i + 1
Next cll
Next colm
'or:
'For Each rw In myRng.Rows
' For Each cll In rw.Cells
' Dataset(i, 1) = cll
' i = i + 1
' Next cll
'Next rw

Cells(20, 10).Resize(UBound(Dataset)).Value = Dataset 'write the array to the sheet.
End Sub

Lwebzer
11-19-2019, 04:55 PM
Thanks Jolivanes - this is exactly what I was hoping to see. Can you explain to me how this bit Cells(Rows.Count, lc + 1).End(xlUp).Offset(1).Resize(lr - 2).Value = Range(Cells(3, i), Cells(lr, i)).Value

is working?

Thank you so much!

Louis

p45cal
11-19-2019, 05:00 PM
if you choose this code:
For Each rw In myRng.Rows
For Each cll In rw.Cells
Dataset(i, 1) = cll
i = i + 1
Next cll
Next rw
it can be shortened to:
For Each cll In myRng.Cells
Dataset(i, 1) = cll
i = i + 1
Next cll



If you have a much bigger grid to convert, it can be sped up considerably with a tweak to reduce the number of times the sheet is read from, to once, instead of 16 in your example.

Lwebzer
11-19-2019, 05:02 PM
Thanks very much everyone. Pascal - I'm reviewing and learning from your code now.

Really appreciate the guidance.

p45cal
11-19-2019, 05:19 PM
if you choose this code:
For Each rw In myRng.Rows
For Each cll In rw.Cells
Dataset(i, 1) = cll
i = i + 1
Next cll
Next rw
it can be shortened to:
For Each cll In myRng.Cells
Dataset(i, 1) = cll
i = i + 1
Next cll



If you have a much bigger grid to convert, it can be sped up considerably with a tweak to reduce the number of times the sheet is read from, to once, instead of 16 in your example.

jolivanes
11-19-2019, 05:26 PM
lc is the last used Column. So lc + 1 is one column to the right of the last used Column and is an empty Column where we enter the data.
lr is the last used Row but you have 2 Header Rows so 2 is subtracted from the cells used in each Column and this amount is used in the Resize part.

It all can be done faster but for ease of possibly change/adapt, if you don't have a massive amount of data, this should work.

Lwebzer
11-19-2019, 05:26 PM
Hi Pascal,

I think I get it all apart from this line:

Dataset(i, 1) = cell

How does vba know the reference of the cell (the value of which it is assigning to that reference of "dataset")?

Thank you for your help. No way I would be making any progress without this forum's support.

p45cal
11-19-2019, 05:52 PM
Hi Pascal,

I think I get it all apart from this line:

Dataset(i, 1) = cell

How does vba know the reference of the cell (the value of which it is assigning to that reference of "dataset")?If you add the line:
cll.select
directly after
Dataset(i, 1) = cll

and step through the code with F8 presses on the keyboard, you'll see which cell cll is as it loops.

You can also:

For Each rw In myRng.Rows
rw.select
For Each cll In rw.Cells
Dataset(i, 1) = cll
cll.select
i = i + 1
Next cll
Next rw

Lwebzer
11-19-2019, 06:20 PM
I see - it starts from 1,1 within the specified range and then works its way down.

Thanks!!

Lwebzer
11-19-2019, 06:21 PM
Thank you to everyone who helped me to remove this roadblock! I get it now.

:)
Going to make this as solved.

snb
11-20-2019, 01:27 AM
This code suffices:


Sub M_snb()
sn = Cells(1).CurrentRegion.Offset(2, 1).SpecialCells(2)

For Each it In sn
c00 = c00 & "_" & it
Next

Cells(1, 10).Resize(UBound(Split(c00, "_"))) = Application.Transpose(Split(Mid(c00, 2), "_"))
End Sub

Lwebzer
11-20-2019, 11:53 AM
Thanks SNB.

I do really appreciate your replies, but it's hard for me to understand and learn from the code that you are posting without any context. For example, your post includes c00, "it", split and mid, all of which are new for me (in vba context, i understand how split and mid are used in excel). I don't want to appear ungrateful because i can sometimes pick some things up but can be tricky.

Lwebzer
11-20-2019, 12:06 PM
Hey everyone,

Below message is split into 3 parts.

1) Context of request


As many of the above generous individuals already know, I am trying to learn the concept of arrays / other vba by carrying out a practical task to convert data in matrix format to list format, in a dynamic, scalable way (e.g., the code can adjust to accommodate varying numbers of row headers and number of data rows / columns).




Here is an example of what I would want to do (convert A > B in the below).

A






Metric


Bookings


Bookings


4 Wall


4 Wall




Date


7/1/2014


8/1/2014


11/1/2014


12/1/2014




1052


$ 38K


$ 31K


$ 120K


$ 29K




1105


$ -


$ -


$ 9K


$ 0K




1110


$ 25K


$ 56K


$ 37K


$ 35K




1123


$ -


$ 25K


$ -


$ 21K






B





Customer ID


Metric


Date


Value




1052


Bookings


7/1/2014


$ 38K




1052


Bookings


7/1/2014


$ -




1052


Bookings


7/1/2014


$ 25K




1052


Bookings


7/1/2014


$ -




1105


Bookings


8/1/2014


$ 31K




1105


Bookings


8/1/2014


$ -




1105


Bookings


8/1/2014


$ 56K




1105


Bookings


8/1/2014


$ 25K




1110


4 Wall


11/1/2014


$ 120K




1110


4 Wall


11/1/2014


$ 9K




1110


4 Wall


11/1/2014


$ 37K




1110


4 Wall


11/1/2014


$ -




1123


4 Wall


12/1/2014


$ 29K




1123


4 Wall


12/1/2014


$ 0K




1123


4 Wall


12/1/2014


$ 35K




1123


4 Wall


12/1/2014


$ 21K






2) My Request


Two steps of the process are, I think, to 1) define / find the data set; 2) convert all of the values from format A > B. You have been awesome in helping me understand how to do this and, with your help (esp. Pascal, Mark, jolivanes, snb). You all helped me come up with the below code.


Now my question is - how do I also convert the rows metric / date / customer ID (examples only that apply to this case - could change depending on dataset) in an efficient, scalable way? If possible, I would love to get guidance on the concepts behind this and how to do it, rather than the exact code I need. If you can possibly give me a high level description of the / a recommended methodology, then I'd love to be able to use that to come up with an "answer" myself that I can hopefully then check with you all.



3) My Code up till now (for reference)




Sub LG_Data_Converter_2()







'Part 1 - Convert_Data




Dim Nmbr_Headers As Byte

Nmbr_Headers = 2

'Nmbr_Headers = Application.InputBox("Input Required", "How many Header Rows are there?", Type:=1, Default:=2)




Dim FirstRow As Long, LastRow As Long, FirstColumn As Long, LastColumn As Long



FirstRow = Cells.Find("*", , , , xlByRows, xlNext).Row

LastRow = Cells.Find("*", , , , xlByRows, xlPrevious).Row

FirstColumn = Cells.Find("*", , , , xlByColumns, xlNext).Column

LastColumn = Cells.Find("*", , , , xlByColumns, xlPrevious).Column



Dim No_Data_Rows As Long

No_Data_Rows = LastRow - FirstRow - Nmbr_Headers + 1



Dim No_Data_Columns As Long

No_Data_Columns = LastColumn - FirstColumn + 1 - 1 '(Take into account the customer ID column)'







Set DatasetRange = Range(Cells(FirstRow + 1, FirstColumn + 1), Cells(LastRow, LastColumn)) 'all data incl headers, i've been playing around wiht this, can obviously adjust it to be just the values only and not the headers







Dim Dataset() As Variant

ReDim Dataset(1 To DatasetRange.Cells.Count, 1 To No_Data_Columns)




i = 1

j = 1




For Each Column In DatasetRange.Columns

For Each cell In Column.Cells

Dataset(i, 1) = cell

i = i + 1

Next cell

Next Column







Cells(LastRow + 3, LastColumn + 1).Resize(UBound(Dataset)).Value = Dataset 'write the array to the sheet.










'These are random notes - what I've been trying hasn't been working too well so I'm coming back to you all




'Part 2 - Convert Header Metric







'Dim Metric_Row As Range, Metric As Variant, No_Metrics As Long, List As Object

'Set Metric_Row = Range(Cells(FirstRow, FirstColumn + 1), Cells(FirstRow, LastColumn))

'

'Set List = CreateObject("Scripting.Dictionary")

'

'For Each Metric In Metric_Row

'If List.Exists(Metric.Value) = False Then List.Add Metric.Value, Nothing

'Next

'

'No_Metrics = List.Count

'




End Sub

Lwebzer
11-22-2019, 02:12 AM
Hey Pascal,

I had to revert to the second method because i kept getting memory failures. So now my code reads something like this:

Dim No_Data_Columns As Long
No_Data_Columns = LastColumn - FirstColumn + 1 - 1 '(Take into account the customer ID column)'




Set DatasetRange = Range(Cells(FirstRow + Nmbr_Headers, FirstColumn + 1), Cells(LastRow, LastColumn)) 'all data incl headers, i've been playing around wiht this, can obviously adjust it to be just the values only and not the headers




Dim Dataset() As Variant
ReDim Dataset(1 To No_Data_Rows * No_Data_Columns)


Dim i As Integer
i = 1




For Each cll In DatasetRange.Cells
Dataset(i) = cll
i = i + 1
Next cll


Cells(200, 10).Resize(UBound(Dataset)).Value = Application.Transpose(Dataset)

I didn't realize for ages about the transpose thing. But I think i got it. Thanks for your help - think i finally am getting the hang of these arrays.




if you choose this code:
For Each rw In myRng.Rows
For Each cll In rw.Cells
Dataset(i, 1) = cll
i = i + 1
Next cll
Next rw
it can be shortened to:
For Each cll In myRng.Cells
Dataset(i, 1) = cll
i = i + 1
Next cll



If you have a much bigger grid to convert, it can be sped up considerably with a tweak to reduce the number of times the sheet is read from, to once, instead of 16 in your example.

Lwebzer
11-22-2019, 07:22 AM
I think I got there. Here's my code in case this is helpful to anyone! Heads up - it's probably pretty ugly, but it does work quite dynamically. Thanks to Pascal especially for the help. This is an awesome forum!! You all are awesome. :)

SubLG_Data_Converter_2()


'Part 1 -Convert_Data


Dim Nmbr_Headers AsByte
Nmbr_Headers = 2

' OR Nmbr_Headers =Application.InputBox("Input Required", "How many Header Rows arethere?", Type:=1, Default:=2)
Dim FirstRow AsLong, LastRow As Long, FirstColumn As Long, LastColumn As Long
FirstRow =Cells.Find("*", , , , xlByRows, xlNext).Row
LastRow =Cells.Find("*", , , , xlByRows, xlPrevious).Row
FirstColumn =Cells.Find("*", , , , xlByColumns, xlNext).Column
LastColumn =Cells.Find("*", , , , xlByColumns, xlPrevious).Column


Dim No_Data_Rows AsLong
No_Data_Rows =LastRow - FirstRow - Nmbr_Headers + 1


Dim No_Data_ColumnsAs Long
No_Data_Columns =LastColumn - FirstColumn + 1 - 1 '(Take into account the customer ID column)'


Set DatasetRange =Range(Cells(FirstRow + Nmbr_Headers, FirstColumn + 1), Cells(LastRow,LastColumn))


Dim Dataset() AsVariant
ReDim Dataset(1 ToNo_Data_Rows * No_Data_Columns)

a = 1


For Each cll InDatasetRange.Cells
Dataset(a) = cll
a = a + 1
Next cll


'Convert Metric

Set Metric_Row =Range(Cells(FirstRow, FirstColumn + 1), Cells(FirstRow, LastColumn))

Dim Metric_Set AsVariant
ReDim Metric_Set(1To No_Data_Rows * No_Data_Columns)


b = 1

Do
For Each Cell InMetric_Row.Cells
Metric_Set(b) = Cell
b = b + 1
Next Cell
Loop Until b =((No_Data_Rows * No_Data_Columns) + 1)

'Convert Date

&nbsp

Lwebzer
11-22-2019, 07:23 AM
Last code entry got cut off.



SubLG_Data_Converter_2()


'Part 1 -Convert_Data


Dim Nmbr_Headers AsByte
Nmbr_Headers = 2

' OR Nmbr_Headers =Application.InputBox("Input Required", "How many Header Rows arethere?", Type:=1, Default:=2)
Dim FirstRow AsLong, LastRow As Long, FirstColumn As Long, LastColumn As Long
FirstRow =Cells.Find("*", , , , xlByRows, xlNext).Row
LastRow =Cells.Find("*", , , , xlByRows, xlPrevious).Row
FirstColumn =Cells.Find("*", , , , xlByColumns, xlNext).Column
LastColumn =Cells.Find("*", , , , xlByColumns, xlPrevious).Column


Dim No_Data_Rows AsLong
No_Data_Rows =LastRow - FirstRow - Nmbr_Headers + 1


Dim No_Data_ColumnsAs Long
No_Data_Columns =LastColumn - FirstColumn + 1 - 1 '(Take into account the customer ID column)'


Set DatasetRange =Range(Cells(FirstRow + Nmbr_Headers, FirstColumn + 1), Cells(LastRow,LastColumn))


Dim Dataset() AsVariant
ReDim Dataset(1 ToNo_Data_Rows * No_Data_Columns)

a = 1


For Each cll InDatasetRange.Cells
Dataset(a) = cll
a = a + 1
Next cll


'Convert Metric

Set Metric_Row =Range(Cells(FirstRow, FirstColumn + 1), Cells(FirstRow, LastColumn))

Dim Metric_Set AsVariant
ReDim Metric_Set(1To No_Data_Rows * No_Data_Columns)


b = 1

Do
For Each Cell InMetric_Row.Cells
Metric_Set(b) = Cell
b = b + 1
Next Cell
Loop Until b =((No_Data_Rows * No_Data_Columns) + 1)

'Convert Date


Set Date_Row =Range(Cells(FirstRow + 1, FirstColumn + 1), Cells(FirstRow + 1, LastColumn))

Dim Date_Set AsVariant
ReDim Date_Set(1 ToNo_Data_Rows * No_Data_Columns)

c = 1

Do
For Each Cell InDate_Row.Cells
Date_Set(c) = Cell
c = c + 1
Next Cell
Loop Until c =((No_Data_Rows * No_Data_Columns) + 1)


'Convert Customer_ID


Set ID_Column =Range(Cells(FirstRow + Nmbr_Headers, FirstColumn), Cells(LastRow, FirstColumn))

Dim ID_Set AsVariant
ReDim ID_Set(1 ToNo_Data_Rows * No_Data_Columns)

d = 1
e = 0


For Each Cell InID_Column.Cells
Do
ID_Set(d) = Cell
d = d + 1
e = e + 1
Loop Until e =No_Data_Columns
e = 0
Next Cell

Dim Sheet AsWorksheet
Set Sheet =ActiveWorkbook.Sheets.Add(After:=ActiveWorkbook.Worksheets(ActiveWorkbook. Worksheets.Count))
Sheet.Name ="Converted_Data"


Sheets("Converted_Data").Cells(4,3) = "ID"
Sheets("Converted_Data").Cells(4,4) = "Period"
Sheets("Converted_Data").Cells(4,5) = "Metric"
Sheets("Converted_Data").Cells(4,6) = "Value"


Sheets("Converted_Data").Cells(5,3).Resize(UBound(ID_Set)).Value = Application.Transpose(ID_Set)
Sheets("Converted_Data").Cells(5,4).Resize(UBound(Date_Set)).Value = Application.Transpose(Date_Set)
Sheets("Converted_Data").Cells(5,5).Resize(UBound(Metric_Set)).Value = Application.Transpose(Metric_Set)
Sheets("Converted_Data").Cells(5,6).Resize(UBound(Dataset)).Value = Application.Transpose(Dataset)



End Sub

p45cal
11-22-2019, 09:33 AM
The attached hopefully contains something more flexible.
You have already explored many ways of determining the extent of the table, the number of header rows and columns. I leave that to you.
The macro is called blah and it's in the p45cal code module.
The attached only asks the user to identify the whole table and then the databody of the table, the code then works out the rest. It also tries to create headers from that top left part of the table where column headers and row headers intersect. There is no convention which says what these labels refer to so inevitably the bottom right cell of this range is used twice as a header - up to you to update the incorrect output header manually.
As I've left it, the code is meant to be run by stepping through it so that you can follow what's being copied from where to where. There are many lines which can later be removed, labeled with the comment: 'debug line.
I've left several sheets with the results, being your original sheet along with others with different headers, and one with no headers at all.

I haven't used arrays at all in the code, there are many read/writes to the sheet, one cell's value being transferred at a time; this doesn't copy formatting (using arrays wouldn't copy formatting either) but there is an alternative, commented-out line below each transfer line which does copy formatting. If your tables are huge this method will be slow. If I get the time and the inclination (and the say so from you) I could rewrite an array version which would be hundreds of times faster.

p45cal
11-22-2019, 09:56 AM
Be very careful with Transpose!
If you add a line:

x = Application.Transpose(Date_Set)
to your code and examine/compare Date_Set and x in the Locals pane you will see that while Date_Set contains values of type Date, x contains values of type String. When strings are written to the sheet you're hoping that whichever locale you're using Excel in the date format is the same as the strings in x, because Excel tries to be helpful and converts a string that looks like a date, into a real date but will get it wrong if the month/day position is different as in US/UK dates.

You can avoid Transpose by changing:
ReDim Date_Set(1 To No_Data_Rows * No_Data_Columns)
to:
ReDim Date_Set(1 To No_Data_Rows * No_Data_Columns, 1 To 1)

and changing:
Date_Set(c) = Cell
to:
Date_Set(c, 1) = Cell

and changing:
Sheets("Converted_Data").Cells(5, 4).Resize(UBound(Date_Set)).Value = Application.Transpose(Date_Set)
to:
Sheets("Converted_Data").Cells(5, 4).Resize(UBound(Date_Set)).Value = Date_Set

Lwebzer
11-22-2019, 10:06 AM
Got it. I'll look through that again - I don't like transpose much at all but it was the only way i could get the damn thing to work. I need to review your code thoroughly this weekend. Thank you so much for all your help!

p45cal
11-22-2019, 10:09 AM
I don't like transpose much at all but it was the only way i could get the damn thing to work.See update to my previous message