Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 536
Default Eliminate blanks while copy row and transpose

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
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,872
Default Eliminate blanks while copy row and transpose

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
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,872
Default Eliminate blanks while copy row and transpose

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
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 536
Default Eliminate blanks while copy row and transpose


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
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,872
Default Eliminate blanks while copy row and transpose

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


  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 536
Default Eliminate blanks while copy row and transpose



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



  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,872
Default Eliminate blanks while copy row and transpose

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
  #8   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,514
Default Eliminate blanks while copy row and transpose

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

  #9   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 536
Default Eliminate blanks while copy row and transpose

On Friday, November 29, 2013 5:51:05 AM UTC-8, Claus Busch wrote:
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




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


  #10   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,872
Default Eliminate blanks while copy row and transpose

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)


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.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2


  #11   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 536
Default Eliminate blanks while copy row and transpose

On Friday, November 29, 2013 12:25:59 PM UTC-8, Claus Busch wrote:
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)




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.



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
  #12   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 536
Default Eliminate blanks while copy row and transpose

On Friday, November 29, 2013 10:24:55 AM UTC-8, GS wrote:
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



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
  #13   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,514
Default Eliminate blanks while copy row and transpose

On Friday, November 29, 2013 10:24:55 AM UTC-8, GS wrote:
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



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


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



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

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
transpose skip 0's and blanks ali Excel Programming 3 July 20th 07 02:19 AM
transpose without 0's and blanks ali Excel Discussion (Misc queries) 2 July 19th 07 02:20 AM
Transpose and remove blanks KarenB Excel Programming 1 January 31st 07 05:24 PM
eliminate blanks from listbox rowsource Jacob Excel Programming 3 November 1st 06 06:45 PM
Eliminate blanks before a charachter chain MónicaM[_2_] Excel Programming 2 April 22nd 06 03:26 AM


All times are GMT +1. The time now is 04:30 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"