Eliminate blanks while copy row and transpose

H

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
 
C

Claus Busch

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
Click to expand...


Regards
Claus B.
 
C

Claus Busch

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.
Click to expand...

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.
 
H

Howard

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.
Click to expand...

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
 
H

Howard

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:
Click to expand...


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
 
C

Claus Busch

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.
Click to expand...

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.
 
G

GS

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.
Click to expand...

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
 
H

Howard

Hi Howard,



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






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
Click to expand...



I'll try again.

C1 has drop down with a list A through K.

Cells C3 to C13 = A, B, C, D, E on down to C13 = K.

To the right of each letter on that row are the data and some blanks.
(Using a letter to designate a row is a bit confusing)

So, selecting F in C1 would mean:

Copy C8 and all cells to the right in that row to the end of data, minus the blanks.

You have posted code that does that quite nicely to column A on sheet 2.

Prefer each copy to sheet 2 be in a separate column.

I will give your latest code a try.

Thanks.
Howard
 
C

Claus Busch

Hi Howard,

Am Fri, 29 Nov 2013 11:59:13 -0800 (PST) schrieb Howard:
C1 has drop down with a list A through K.

Cells C3 to C13 = A, B, C, D, E on down to C13 = K.

To the right of each letter on that row are the data and some blanks.
(Using a letter to designate a row is a bit confusing)
Click to expand...

try:

Sub BlankOutSheet4()
Dim rngC As Range
Dim lCol As Long
Dim myCount As Long
Dim varOut() As Variant
Dim i As Long
Dim PnRow As Integer


With Sheets("Sheet1")
PnRow = Asc(.Range("C1")) - 62
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
lCol = Sheets("Sheet2").Cells(1, Columns.Count).End(xlToLeft).Column
If Len(Sheets("Sheet2").Cells(1, lCol)) = 0 Then
Sheets("Sheet2").Cells(1, lCol).Resize(rowsize:= _
UBound(varOut) + 1) = WorksheetFunction.Transpose(varOut)
Else
Sheets("Sheet2").Cells(1, lCol + 1).Resize(rowsize:= _
UBound(varOut) + 1) = WorksheetFunction.Transpose(varOut)
End If
End With
End Sub


Regards
Claus B.
 
H

Howard

Hi Howard,



Am Fri, 29 Nov 2013 11:59:13 -0800 (PST) schrieb Howard:







try:



Sub BlankOutSheet4()

Dim rngC As Range

Dim lCol As Long

Dim myCount As Long

Dim varOut() As Variant

Dim i As Long

Dim PnRow As Integer





With Sheets("Sheet1")

PnRow = Asc(.Range("C1")) - 62

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

lCol = Sheets("Sheet2").Cells(1, Columns.Count).End(xlToLeft).Column

If Len(Sheets("Sheet2").Cells(1, lCol)) = 0 Then

Sheets("Sheet2").Cells(1, lCol).Resize(rowsize:= _

UBound(varOut) + 1) = WorksheetFunction.Transpose(varOut)

Else

Sheets("Sheet2").Cells(1, lCol + 1).Resize(rowsize:= _

UBound(varOut) + 1) = WorksheetFunction.Transpose(varOut)

End If

End With

End Sub





Regards

Claus B.
Click to expand...


Yes indeed, that works nicely!

Converting the string in C1 to an Integer and then using it throughout the code will take some study time on my part.

Sure works nice.

Thank a lot.
Case closed.

Regards,
Howard
 
H

Howard

Perhaps...



lCol = .UsedRange.Columns.Count '+ 1
Click to expand...


Hi Garry,

Where I struggle here is how to make lCol + 1 represent the next column on sheet 2.

I've tried this and then used lCol2 in the destination code line, but no luck.

Dim lCol2 As Long
With Sheets("Sheet2")
lCol2 = .Cells(2, .Columns.Count).End(xlToLeft).Column
End With

Howard
 
G

GS

Hi Garry,

Where I struggle here is how to make lCol + 1 represent the next
column on sheet 2.

I've tried this and then used lCol2 in the destination code line, but
no luck.

Dim lCol2 As Long
With Sheets("Sheet2")
lCol2 = .Cells(2, .Columns.Count).End(xlToLeft).Column
End With

Howard
Click to expand...

If your target sheet only receives data 1 col at a time then either
method should work for you. You must include the +1, though, if you
want to shift 1 col to the right. Otherwise...

lCol2 = .UsedRange.Columns.Count + 1

-OR-

lCol2 = .Cells(2, .Columns.Count).End(xlToLeft).Column + 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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Object variable or with Block variable not set 9
VBA - (re-) Set a Table Style 2
Columns as variable in Vlookup 5
Copy columns and paste with blank column between 5
Cell values to an array, then array transpose to another workbook 8
Remove Identical words 0
Code works but goes into endless loop and crashes 1
Search other sheets for numbers & color them 10

Top