Each row in the C3:C10 range has various number of columns, and a few blanks in each row, arbitrary across row.

Want to copy and transpose each row, minus the blank cells to sheet 2.

I am happy with either the sheet 2 destination as Column A .xlup.offset(1,0) OR each copied row to a separate adjacent column on sheet 2.

This code below works "kinda okay" to copy and transpose on the same sheet.

I have tried to use Autofilter to "hide" the blanks in place and copy and transpose only the remaining row data to sheet 2, then turn Autofilter off to retain original data as was, blanks and all.

Lost of advice about Autofilter on columns, but cannot find something useful dealing with blanks in a row.

Thanks.
Howard

Option Explicit

Sub BlankOutSheet()
Dim c As Range, Rng As Range
Dim PnRow As String
Dim lCol As Long
Dim cRow As Long

PnRow = Range("C1")

For Each c In Range("C3:C10")
If c = PnRow Then

cRow = c.Row
lCol = Cells(cRow, Cells.Columns.Count).End(xlToLeft).Column

On Error Resume Next
c.Resize(1, lCol).Copy
Range("C" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _
xlPasteValues, Transpose:=True
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.Delete Shift:=xlUp
Application.CutCopyMode = False
End If
Next

End Sub

Hi Howard,

Am Thu, 28 Nov 2013 13:17:13 -0800 (PST) schrieb Howard:

Each row in the C3:C10 range has various number of columns, and a few blanks in each row, arbitrary across row.

Want to copy and transpose each row, minus the blank cells to sheet 2.

I am happy with either the sheet 2 destination as Column A .xlup.offset(1,0) OR each copied row to a separate adjacent column on sheet 2.

This code below works "kinda okay" to copy and transpose on the same sheet.

I have tried to use Autofilter to "hide" the blanks in place and copy and transpose only the remaining row data to sheet 2, then turn Autofilter off to retain original data as was, blanks and all.

Lost of advice about Autofilter on columns, but cannot find something useful dealing with blanks in a row.

Thanks.
Howard

Option Explicit

Sub BlankOutSheet()
Dim c As Range, Rng As Range
Dim PnRow As String
Dim lCol As Long
Dim cRow As Long

PnRow = Range("C1")

For Each c In Range("C3:C10")
If c = PnRow Then

cRow = c.Row
lCol = Cells(cRow, Cells.Columns.Count).End(xlToLeft).Column

On Error Resume Next
c.Resize(1, lCol).Copy
Range("C" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _
xlPasteValues, Transpose:=True
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.Delete Shift:=xlUp
Application.CutCopyMode = False
End If
Next

End Sub


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

Hi Howard,

Am Thu, 28 Nov 2013 13:17:13 -0800 (PST) schrieb Howard:

Each row in the C3:C10 range has various number of columns, and a few blanks in each row, arbitrary across row.

Want to copy and transpose each row, minus the blank cells to sheet 2.

I am happy with either the sheet 2 destination as Column A .xlup.offset(1,0) OR each copied row to a separate adjacent column on sheet 2.

copy only cells with values:

Sub BlankOutSheet2()
Dim c As Range
Dim lCol As Long

Application.ScreenUpdating = False
With Sheets("Sheet1")
For Each c In .Range("C3:C10").Rows
lCol = .Cells(c.Row, .Columns.Count).End(xlToLeft).Column
.Range(.Cells(c.Row, 3), .Cells(c.Row, lCol)) _
.SpecialCells(xlCellTypeConstants, 3).Copy
Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) _
.PasteSpecial xlPasteValues, Transpose:=True
Next
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

copy only cells with values:



Sub BlankOutSheet2()

Dim c As Range

Dim lCol As Long



Application.ScreenUpdating = False

With Sheets("Sheet1")

For Each c In .Range("C3:C10").Rows

lCol = .Cells(c.Row, .Columns.Count).End(xlToLeft).Column

.Range(.Cells(c.Row, 3), .Cells(c.Row, lCol)) _

.SpecialCells(xlCellTypeConstants, 3).Copy

Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) _

.PasteSpecial xlPasteValues, Transpose:=True

Next

End With

Application.CutCopyMode = False

Application.ScreenUpdating = True

End Sub

Regards

Claus B.

Spot on, as usual, many thanks.

I tweaked the code to take its cue of which row to copy with a reference to a drop down in C1.

Thanks Claus.

Regards,
Howard

Hi Howard,

Am Fri, 29 Nov 2013 02:28:16 -0800 (PST) schrieb Howard:

I tweaked the code to take its cue of which row to copy with a reference to a drop down in C1.

if the order of the values is not important you can copy and transpose
and then sort column A in Sheet2 to eliminate the blank cells.

Or you can read the values in an array:

Sub BlankOutSheet3()
Dim R As Range, rngC As Range
Dim lCol As Long
Dim myCount As Long
Dim varOut() As Variant
Dim i As Long

With Sheets("Sheet1")
For Each R In .Range("C3:C10").Rows
lCol = .Cells(R.Row, .Columns.Count).End(xlToLeft).Column
myCount = WorksheetFunction.CountA _
(.Range(.Cells(R.Row, 3), .Cells(R.Row, lCol)))
i = 0
For Each rngC In .Range(.Cells(R.Row, 3), .Cells(R.Row, lCol))
ReDim Preserve varOut(myCount - 1)
If Len(rngC) 0 Then
varOut(i) = rngC
i = i + 1
End If
Next
Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp)(2) _
.Resize(rowsize:=UBound(varOut) + 1) = _
WorksheetFunction.Transpose(varOut)
Next
End With
End Sub

I did not take the run time but I think the array is a little bit faster
than copy


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

if the order of the values is not important you can copy and transpose

and then sort column A in Sheet2 to eliminate the blank cells.



Or you can read the values in an array:


I'll post this last code in the sheet for reference. Thanks.

I think a better way to describe what goes to sheet 2 two is current need.

With the rows designated C3 and down as A, B, C, D, etc. So in the drop down in C1 the choices may be B, E, then F, moving only three rows (one at a time) to sheet 2 at this time. Then later may want G, & H. Or any other combination from time to time.

I suspect the data are part numbers which gets changed, added to and deleted.

I have been trying to make each transpose go to a column for each row copied and transposed. Next transpose goes to next empty column on sheet 2. That has become more difficult than I guessed.

Having seen several transposes in a single column, seems clumsy to analyze.

lCol = .Cells(R.Row, .Columns.Count).End(xlToLeft).Column

This is easy enough for sheet 1, but I am having major problems using like code to find the lastColumn for sheet 2 and using it in the copy-to code line.

Howard

Hi Howard,

Am Fri, 29 Nov 2013 05:03:38 -0800 (PST) schrieb Howard:

With the rows designated C3 and down as A, B, C, D, etc. So in the drop down in C1 the choices may be B, E, then F, moving only three rows (one at a time) to sheet 2 at this time. Then later may want G, & H. Or any other combination from time to time.

I suspect the data are part numbers which gets changed, added to and deleted.

I don't really understand your explanation.
Do you have numbers in C1 for the row. What do you want to copy? The row
from column A to LCol?

I have numbers in C1 (1 to 8). The
range(cells(C1+2,"C"),cells(C1+2,LCol)) will be copied and transposed
to A1 of Sheet2, if A1 is empty. Otherwise it will be pasted to B1 and
so on:

Sub BlankOutSheet3()
Dim R As Range, rngC As Range
Dim lCol As Long
Dim myCount As Long
Dim varOut() As Variant
Dim i As Long
Dim PnRow As Long

PnRow = Range("C1") + 2
With Sheets("Sheet1")
lCol = .Cells(PnRow, .Columns.Count).End(xlToLeft).Column
myCount = WorksheetFunction.CountA _
(.Range(.Cells(PnRow, 3), .Cells(PnRow, lCol)))
i = 0
For Each rngC In .Range(.Cells(PnRow, 3), .Cells(PnRow, lCol))
ReDim Preserve varOut(myCount - 1)
If Len(rngC) 0 Then
varOut(i) = rngC
i = i + 1
End If
Next
End With
With Sheets("Sheet2")
If Len(.Range("A1")) = 0 Then
.Range("A1").Resize(rowsize:=UBound(varOut) + 1) = _
WorksheetFunction.Transpose(varOut)
Else
.Cells(1, Columns.Count).End(xlToLeft).Offset(, 1) _
.Resize(rowsize:=UBound(varOut) + 1) = _
WorksheetFunction.Transpose(varOut)
End If
End With
End Sub


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

This is easy enough for sheet 1, but I am having major problems using
like code to find the lastColumn for sheet 2 and using it in the
copy-to code line.

Perhaps...

lCol = .UsedRange.Columns.Count '+ 1

--
Garry

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



---
This email is free from viruses and malware because avast! Antivirus protection is active.
http://www.avast.com