Array only returning first column of values

[Lwebzer]

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]

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]

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]

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]

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]

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]

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