Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Looping Every Nth Row to Copy & Paste Special
I have some code that goes through a range (for example, D1:H10) and for
every 3rd row, it highlights D3:H3, copies it and then moves up one row to D2 and paste specials the value. I'm trying to alter a piece of code I used to insert the formula in the same cell range that I am copying and pasting, but I'm missing how to prevent it from not selecting every 3rd row in the range as it loops. Here's the code: -----Begin Code----- Dim ColsSelection Dim RowsSelection Dim RowsBetween Dim Diff Dim FinalRange Dim xCell Range("D1:H10").Select ColsSelection = Selection.Columns.Count RowsSelection = Selection.Rows.Count RowsBetween = 3 Diff = Selection.Row - 1 Selection.Resize(RowsSelection, 1).Select Set FinalRange = Selection. _ Offset(RowsBetween - 1, 0).Resize(1, ColsSelection) For Each xCell In Selection If xCell.Row Mod RowsBetween = Diff Then Set FinalRange = Application.Union _ (FinalRange, xCell.Resize(1, ColsSelection)) FinalRange.Select Selection.Copy ActiveCell.Offset(-1, 0).Select Selection.PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False Selection.NumberFormat = "0" End If Next xCell Range("A2").Activate End Sub -----End Code----- Specifically, this piece to the code: Set FinalRange = Application.Union(FinalRange, xCell.Resize(1, ColsSelection)) Tells it to keep adding to the selected range, but I don't want it to keep adding to the selected range. I want it to move down 4 rows and then select D6:H6 and copy and paste special value again. I tried commenting out the Union code, but then it keeps selecting D3:H3 through each loop. Any suggestions as to how I can get it to stop adding to the selected range? Thanks for any help. |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Looping Every Nth Row to Copy & Paste Special
Hi
Try this (not tested): Sub aaa() Dim TargetRange As Range Dim ColsSelection Dim RowsSelection Dim RowsBetween Dim Diff Dim CopyRange As Range Dim xCell Set TargetRange = Range("D1:H10") ColsSelection = TargetRange.Columns.Count RowsSelection = TargetRange.Rows.Count RowsBetween = 3 Diff = Selection.Row - 1 For Each xCell In TargetRange.Columns(1) If xCell.Row Mod RowsBetween = Diff Then Set CopyRange = xCell.Resize(1, ColsSelection) CopyRange.Copy TargetRange.Cells(1, 1).Offset(off, 0).PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False TargetRange.Cells(1, 1).Offset(off, 0).Resize(1, ColsSelection).NumberFormat = "0" End If Next xCell 'Range("A2").Activate End Sub Regards, Per On 7 Maj, 01:26, mcwilsong wrote: I have some code that goes through a range (for example, D1:H10) and for every 3rd row, it highlights D3:H3, copies it and then moves up one row to D2 and paste specials the value. I'm trying to alter a piece of code I used to insert the formula in the same cell range that I am copying and pasting, but I'm missing how to prevent it from not selecting every 3rd row in the range as it loops. Here's the code: -----Begin Code----- Dim ColsSelection Dim RowsSelection Dim RowsBetween Dim Diff Dim FinalRange Dim xCell * * Range("D1:H10").Select * * ColsSelection = Selection.Columns.Count * * RowsSelection = Selection.Rows.Count * * RowsBetween = 3 * * Diff = Selection.Row - 1 * * Selection.Resize(RowsSelection, 1).Select * * Set FinalRange = Selection. _ * * * *Offset(RowsBetween - 1, 0).Resize(1, ColsSelection) * * For Each xCell In Selection * * * * If xCell.Row Mod RowsBetween = Diff Then * * * * * * Set FinalRange = Application.Union _ * * * * * * * * (FinalRange, xCell.Resize(1, ColsSelection)) * * * * * * FinalRange.Select * * * * * * Selection.Copy * * * * * * ActiveCell.Offset(-1, 0).Select * * * * * * Selection.PasteSpecial Paste:=xlPasteValues * * * * * * Application.CutCopyMode = False * * * * * * Selection.NumberFormat = "0" * * * * End If * * Next xCell * * Range("A2").Activate End Sub -----End Code----- Specifically, this piece to the code: Set FinalRange = Application.Union(FinalRange, xCell.Resize(1, ColsSelection)) Tells it to keep adding to the selected range, but I don't want it to keep adding to the selected range. I want it to move down 4 rows and then select D6:H6 and copy and paste special value again. I tried commenting out the Union code, but then it keeps selecting D3:H3 through each loop. Any suggestions as to how I can get it to stop adding to the selected range? Thanks for any help. |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Looping Every Nth Row to Copy & Paste Special
Thanks for the reply Per ... I have a few questions about the sample code you
provided. You use the offset command to move down one row and paste the cells just copied, however, I'm not sure what "off" is supposed to be in this line. TargetRange.Cells(1, 1).Offset(off, 0).PasteSpecial _ Paste:=xlPasteValues I took it as meaning the number of rows to offset by, which in my case is -1. Unfortunately, this particular script didn't work for me, as it copied the first row range (D1:H1) instead of D3:H3 and it had nowhere to go to paste special. I tried changing the start of the target range to begin at the row I wanted to begin the copy (D3), but the code now just skips through everything and does nothing. Maybe a bit more background would be helpful. Row 1 contains the column headings. When I began altering the original code, I realized it only worked when I included the first row, which is how I was able to get it to fill the formula to D3:H3. Now, I wish to copy the formula from D3:H3 and paste special to D2:H2. Then from D6:H6 to D5:H5. Then from D9:H9 to D8:H8 and so forth. Another question I have about your code, does it make a huge difference to use the targetrange command again just to format the cells? Looping through my original code, I realized that the cells that just received the pasted formula was already highlighted. Any ideas as to how I can tweak this code? I think I've hit my Excel VBA tipping point messing around with this! "Per Jessen" wrote: Hi Try this (not tested): Sub aaa() Dim TargetRange As Range Dim ColsSelection Dim RowsSelection Dim RowsBetween Dim Diff Dim CopyRange As Range Dim xCell Set TargetRange = Range("D1:H10") ColsSelection = TargetRange.Columns.Count RowsSelection = TargetRange.Rows.Count RowsBetween = 3 Diff = Selection.Row - 1 For Each xCell In TargetRange.Columns(1) If xCell.Row Mod RowsBetween = Diff Then Set CopyRange = xCell.Resize(1, ColsSelection) CopyRange.Copy TargetRange.Cells(1, 1).Offset(off, 0).PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False TargetRange.Cells(1, 1).Offset(off, 0).Resize(1, ColsSelection).NumberFormat = "0" End If Next xCell 'Range("A2").Activate End Sub Regards, Per On 7 Maj, 01:26, mcwilsong wrote: I have some code that goes through a range (for example, D1:H10) and for every 3rd row, it highlights D3:H3, copies it and then moves up one row to D2 and paste specials the value. I'm trying to alter a piece of code I used to insert the formula in the same cell range that I am copying and pasting, but I'm missing how to prevent it from not selecting every 3rd row in the range as it loops. Here's the code: -----Begin Code----- Dim ColsSelection Dim RowsSelection Dim RowsBetween Dim Diff Dim FinalRange Dim xCell Range("D1:H10").Select ColsSelection = Selection.Columns.Count RowsSelection = Selection.Rows.Count RowsBetween = 3 Diff = Selection.Row - 1 Selection.Resize(RowsSelection, 1).Select Set FinalRange = Selection. _ Offset(RowsBetween - 1, 0).Resize(1, ColsSelection) For Each xCell In Selection If xCell.Row Mod RowsBetween = Diff Then Set FinalRange = Application.Union _ (FinalRange, xCell.Resize(1, ColsSelection)) FinalRange.Select Selection.Copy ActiveCell.Offset(-1, 0).Select Selection.PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False Selection.NumberFormat = "0" End If Next xCell Range("A2").Activate End Sub -----End Code----- Specifically, this piece to the code: Set FinalRange = Application.Union(FinalRange, xCell.Resize(1, ColsSelection)) Tells it to keep adding to the selected range, but I don't want it to keep adding to the selected range. I want it to move down 4 rows and then select D6:H6 and copy and paste special value again. I tried commenting out the Union code, but then it keeps selecting D3:H3 through each loop. Any suggestions as to how I can get it to stop adding to the selected range? Thanks for any help. |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Looping Every Nth Row to Copy & Paste Special
If anyone is interested, here's how I solved my problem:
Sub CopyPasteEveryNthRow() Dim ColsSelection Dim RowsSelection Dim RowsBetween Dim Diff Dim CopyRange As Range Dim xCell ' Initialize the range to be evaluated. Range("D2:H743").Select ' Initialize ColsSelection and make it equal to the ' number of columns in the selection. ColsSelection = Selection.Columns.Count ' Initialize RowsSelection and make it equal to the ' number of rows in your selection. RowsSelection = Selection.Rows.Count ' Initialize RowsBetween equal to two. RowsBetween = 2 ' Initialize Diff equal to one row less than the first ' row number of the selection. Diff = Selection.Row - 1 ' Resize the selection to be 1 column wide and the same ' number of rows long as the initial selection. Selection.Resize(RowsSelection, 1).Select ' Loop through each row in the selection and stop when ' the cell to the right of the active cell is empty. Do Until IsEmpty(ActiveCell.Offset(0, 1)) ' Make the row below the active cell the range to ' be copied. Set CopyRange = Selection. _ Offset(RowsBetween - 1, 0).Resize(1, ColsSelection) ' Copy the selected range. CopyRange.Copy ' Special paste the values in the active cell. Which is ' one above the row that was copied. ActiveCell.PasteSpecial xlPasteValues ' Format the newly pasted values as numbers to remove the ' date format. Selection.NumberFormat = "0" ' Move down two rows to begin the next loop. ActiveCell.Offset(2, 0).Select ' Iterate loop. Loop ' Once the loop ends, activate the top left most cell. Range("A2").Activate End Sub "mcwilsong" wrote: Thanks for the reply Per ... I have a few questions about the sample code you provided. You use the offset command to move down one row and paste the cells just copied, however, I'm not sure what "off" is supposed to be in this line. TargetRange.Cells(1, 1).Offset(off, 0).PasteSpecial _ Paste:=xlPasteValues I took it as meaning the number of rows to offset by, which in my case is -1. Unfortunately, this particular script didn't work for me, as it copied the first row range (D1:H1) instead of D3:H3 and it had nowhere to go to paste special. I tried changing the start of the target range to begin at the row I wanted to begin the copy (D3), but the code now just skips through everything and does nothing. Maybe a bit more background would be helpful. Row 1 contains the column headings. When I began altering the original code, I realized it only worked when I included the first row, which is how I was able to get it to fill the formula to D3:H3. Now, I wish to copy the formula from D3:H3 and paste special to D2:H2. Then from D6:H6 to D5:H5. Then from D9:H9 to D8:H8 and so forth. Another question I have about your code, does it make a huge difference to use the targetrange command again just to format the cells? Looping through my original code, I realized that the cells that just received the pasted formula was already highlighted. Any ideas as to how I can tweak this code? I think I've hit my Excel VBA tipping point messing around with this! "Per Jessen" wrote: Hi Try this (not tested): Sub aaa() Dim TargetRange As Range Dim ColsSelection Dim RowsSelection Dim RowsBetween Dim Diff Dim CopyRange As Range Dim xCell Set TargetRange = Range("D1:H10") ColsSelection = TargetRange.Columns.Count RowsSelection = TargetRange.Rows.Count RowsBetween = 3 Diff = Selection.Row - 1 For Each xCell In TargetRange.Columns(1) If xCell.Row Mod RowsBetween = Diff Then Set CopyRange = xCell.Resize(1, ColsSelection) CopyRange.Copy TargetRange.Cells(1, 1).Offset(off, 0).PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False TargetRange.Cells(1, 1).Offset(off, 0).Resize(1, ColsSelection).NumberFormat = "0" End If Next xCell 'Range("A2").Activate End Sub Regards, Per On 7 Maj, 01:26, mcwilsong wrote: I have some code that goes through a range (for example, D1:H10) and for every 3rd row, it highlights D3:H3, copies it and then moves up one row to D2 and paste specials the value. I'm trying to alter a piece of code I used to insert the formula in the same cell range that I am copying and pasting, but I'm missing how to prevent it from not selecting every 3rd row in the range as it loops. Here's the code: -----Begin Code----- Dim ColsSelection Dim RowsSelection Dim RowsBetween Dim Diff Dim FinalRange Dim xCell Range("D1:H10").Select ColsSelection = Selection.Columns.Count RowsSelection = Selection.Rows.Count RowsBetween = 3 Diff = Selection.Row - 1 Selection.Resize(RowsSelection, 1).Select Set FinalRange = Selection. _ Offset(RowsBetween - 1, 0).Resize(1, ColsSelection) For Each xCell In Selection If xCell.Row Mod RowsBetween = Diff Then Set FinalRange = Application.Union _ (FinalRange, xCell.Resize(1, ColsSelection)) FinalRange.Select Selection.Copy ActiveCell.Offset(-1, 0).Select Selection.PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False Selection.NumberFormat = "0" End If Next xCell Range("A2").Activate End Sub -----End Code----- Specifically, this piece to the code: Set FinalRange = Application.Union(FinalRange, xCell.Resize(1, ColsSelection)) Tells it to keep adding to the selected range, but I don't want it to keep adding to the selected range. I want it to move down 4 rows and then select D6:H6 and copy and paste special value again. I tried commenting out the Union code, but then it keeps selecting D3:H3 through each loop. Any suggestions as to how I can get it to stop adding to the selected range? Thanks for any help. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Can't Copy and Paste or Paste Special between Excel Workbooks | Excel Discussion (Misc queries) | |||
Looping Paste Special Value Transpose | Excel Programming | |||
Automating copy/paste/paste special when row references change | Excel Programming | |||
help w/ generic copy & paste/paste special routine | Excel Programming | |||
Dynamic Copy/Paste Special Formulas/Paste Special Values | Excel Programming |