Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]() 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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]() 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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
transpose skip 0's and blanks | Excel Programming | |||
transpose without 0's and blanks | Excel Discussion (Misc queries) | |||
Transpose and remove blanks | Excel Programming | |||
eliminate blanks from listbox rowsource | Excel Programming | |||
Eliminate blanks before a charachter chain | Excel Programming |