Column A has a LONG (2000- 4000 + rows) in set of 9 row "clumps" of data.

11 to 19
21 to 29
31 to 39
etc
etc

How do I set myRng to each 9 row clump to be transposed to D2 to L2 and on down, (which works fine using the last line of code.)

Thanks,
Howard

Sub MyArryCellsXpose()
Dim myRng As Range
Dim rngC As Range
Dim i As Long
Dim myArr() As Variant

Set myRng = Range("A1:A9")

For Each rngC In myRng
ReDim Preserve myArr(myRng.Cells.Count - 1)
myArr(i) = rngC
i = i + 1
Next

Sheets("Sheet1").Range("D" & Rows.Count).End(xlUp)(2).Resize(columnsize:=myRng. Cells.Count) = myArr

End Sub

One way...


Sub ColBlocksToRows()
Dim rng As Range
Dim n&, lRow&, lLastRow&, vArr()
lRow = 1 '//initialize for counter increment
lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
Do
lRow = lRow + 10
Set rng = Cells(lRow, 1).Resize(9, 1)
If WorksheetFunction.CountA(rng) 0 Then
vArr(UBound(vArr)) = Join(rng, vbTab)
ReDim Preserve vArr(UBound(vArr) + 1)
End If 'CountA(rng) 0
Loop While lRow < lLastRow

lRow = 1 '//initialize for counter increment
For n = LBound(vArr) To UBound(vArr)
lRow = lRow + 1
Range("D" & lRow).Resize(1, 9) = Split(vArr(n), vbTab)
Next 'n
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Hi Garry,

Hmm, I get a subscript out of range on this line

vArr(UBound(vArr)) = Join(rng, vbTab)

Howard

Hi Garry,

Hmm, I get a subscript out of range on this line

vArr(UBound(vArr)) = Join(rng, vbTab)

Howard

Hmm...! Can't imagine what I was thinking since loading into a var
typed 'As Range' results a 2D array. This works...

Sub ColBlocksToRows()
' Transposes blocks of column data to row data.
' Loads each column block into an array as an array of data,
' resulting in an array of arrays.
' The array is dumped into the worksheet 1 row at a time.

Dim n&, lRow&, lLastRow&, vArr()
lRow = 11 '//initialize to start row
lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
Do
ReDim Preserve vArr(n)
With Application
vArr(n) = .Transpose(.Index(Cells(lRow, "A").Resize(9), 0, 1))
End With 'Application
n = n + 1: lRow = lRow + 10
Loop While lRow < lLastRow

lRow = 1 '//initialize for counter increment
For n = LBound(vArr) To UBound(vArr)
lRow = lRow + 1
Range("D" & lRow).Resize(1, 9) = vArr(n)
Next 'n
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Hi Howard,

Am Mon, 15 Jun 2015 17:11:05 -0700 (PDT) schrieb L. Howard:

Column A has a LONG (2000- 4000 + rows) in set of 9 row "clumps" of data.

11 to 19
21 to 29
31 to 39
etc
etc

How do I set myRng to each 9 row clump to be transposed to D2 to L2 and on down, (which works fine using the last line of code.)

or without array:

Sub Transpose()
Dim LRow As Long, i As Long, n As Long
Dim myRng As Range

n = 2
LRow = Cells(Rows.Count, 1).End(xlUp).Row
With Application
.ScreenUpdating = False
For i = 11 To LRow Step 10
Set myRng = Range(Cells(i, 1), Cells(i + 8, 1))
If .CountA(myRng) 0 Then
Range("D" & n).Resize(1, 9) = .Transpose(myRng)
n = n + 1
End If
Next
.ScreenUpdating = True
End With
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Wow! Kinda where I was going...

Option Explicit

Type udtAppModes
'Default types
Events As Boolean: CalcMode As XlCalculation: Display As Boolean:
CallerID As String
'Project-specific types
End Type
Public AppMode As udtAppModes


Sub ColBlocksToRows2()
' Transposes blocks of column data to row data.
Const sSource$ = "ColBlocksToRows2"

Dim n&, lRow&, lLastRow&, rng As Range
Const lStartRow& = 11 '//edit to suit

On Error GoTo ErrExit: EnableFastCode sSource

lRow = 1 '//initialize for counter increment
lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
For n = lStartRow To lLastRow Step 10
Set rng = Cells(n, 1).Resize(9): lRow = lRow + 1
Range("D" & lRow).Resize(1, 9) = _
Application.Transpose(rng)
Next

ErrExit:
Set rng = Nothing: EnableFastCode sSource, False
End Sub 'ColBlocksToRows2


'--------------------------------------------------------------------------------------
' **Note: EnableFastCode requires the following declarations be in a
standard module.
'--------------------------------------------------------------------------------------
'Type udtAppModes
' 'Default types
' Events As Boolean: CalcMode As XlCalculation: Display As Boolean:
CallerID As String
' 'Project-specific types
'End Type
'Public AppMode As udtAppModes
'--------------------------------------------------------------------------------------
Sub EnableFastCode(Caller$, Optional SetFast As Boolean = True)
' **Note: Requires 'Type udtAppModes' and 'Public AppMode As
udtAppModes' declarations

'The following will make sure only the Caller has control,
'and allows any Caller to take control when not in use.
If AppMode.CallerID < Caller Then _
If AppMode.CallerID < "" Then Exit Sub

With Application
If SetFast Then
AppMode.Display = .ScreenUpdating
.ScreenUpdating = False
AppMode.CalcMode = .Calculation
.Calculation = xlCalculationManual
AppMode.Events = .EnableEvents
.EnableEvents = False
AppMode.CallerID = Caller
Else
.ScreenUpdating = AppMode.Display
.Calculation = AppMode.CalcMode
.EnableEvents = AppMode.Events
AppMode.CallerID = ""
End If
End With
End Sub

...but I didn't see the need for using CountA since we're looping from
start row to last row of data.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Hi Garry,

Am Tue, 16 Jun 2015 03:51:22 -0400 schrieb GS:

..but I didn't see the need for using CountA since we're looping from
start row to last row of data.

only for the case that one of the blocks has no values. Otherwise you
get a blank row.


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Hi Garry,

Am Tue, 16 Jun 2015 03:51:22 -0400 schrieb GS:

..but I didn't see the need for using CountA since we're looping
from start row to last row of data.

only for the case that one of the blocks has no values. Otherwise you
get a blank row.


Regards
Claus B.

Yes, I agree in general. In the case of wanting to know where empty
blocks occur, I prefer to see the blank rows. For example, data dumped
from a data recorder that may contain blank records for any number of
reasons that indicate some troubleshooting is needed.

I included CountA in my original reply instinctively, but gave it a 2nd
thought during sub2.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Hi Garry and Claus,

I tried Garry's revised code and Claus' first code on 6000 rows. Returns 600 rows.

Both are spot on and under 1 second, (mental clock).

Thank you both, appreciate it.

Hi Garry and Claus,

I tried Garry's revised code and Claus' first code on 6000 rows.
Returns 600 rows.

Both are spot on and under 1 second, (mental clock).

Thank you both, appreciate it.

Glad to help!<g
You might find my 2nd version a tad faster than my 1st. Also, I failed
to toggle ScreenUpdating on the 1st version and so adding that may
speed it up some...

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Hi Howard,

Am Tue, 16 Jun 2015 02:01:24 -0700 (PDT) schrieb L. Howard:

I tried Garry's revised code and Claus' first code on 6000 rows. Returns 600 rows.

here is another suggestion.

Sub Transpose2()
Dim LRow As Long, i As Long, n As Long
Dim varOut() As Variant, varTmp As Variant

LRow = Cells(Rows.Count, 1).End(xlUp).Row
With Application
.ScreenUpdating = False
ReDim Preserve varOut(Int(LRow / 10))
For i = 11 To LRow Step 10
varTmp = .Transpose(Cells(i, 1).Resize(9, 1))
varOut(n) = Join(varTmp, ";")
n = n + 1
Next
Range("D2").Resize(n) = .Transpose(varOut)
End With
Columns("D:D").TextToColumns Destination:=Range("D2"),
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
Semicolon:=True, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), _
Array(8, 1), Array(9, 1)), TrailingMinusNumbers:=True
Range("D2:L" & n).NumberFormat = "General"
Application.ScreenUpdating = True
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional