PDA

View Full Version : How to increment a column with a selected range



crthompson1
08-29-2018, 10:59 AM
Hello,

I am trying to copy the data (C6:C78) from an excel spreadsheet Sheet1 and copy it to (C6:C78) in Sheet3. I then want to copy the data from (C6:C78) Sheet2 and copy it to the range (D6:D78) on Sheet3. I then want to copy (D6:D78) from Sheet1 to (E6:E78) on Sheet3. I would then like to copy (D6:D78) from Sheet2 to (F6:F78) on Sheet3 and the pattern continues. How would I increment only the column letter (sometimes the increment is by 1 and sometimes it is by 2) in SourceRange1, SourceRange2, & DestinationRange? The column letters would both need to be incremented such as (C6:C78) becomes (D6:D78) and (C6:C78) becomes (E6:E78). I hope my question makes sense...

Thanks in advance!! My code is listed below:


Dim N As Integer
Dim SourceRange1 As Range
Dim SourceRange2 As Range
Dim DestinationRange As Range
N = 0

'Set the starting copy ranges for sheet1 & sheet2
'Set the starting paste range for sheet3
SourceRange1 = "C6:C78"
SourceRange2 = "C6:C78"
DestinationRange = "C6:C78"
Do Until N = 13

'Cut the first column of data from sheet1 and paste it into the first column of data in sheet3
'Cut 1
'Set0,6,12,18,24,30,36,42,48,54,60,66,72
Sheets("Sheet1").Select
Range(SourceRange1).Select
Selection.Cut
SourceRange1 = SourceRange1 + 2
'Paste 1
Sheets("Sheet7").Select
Range(DestinationRange).Select
ActiveSheet.Paste
DestinationRange = DestinationRange + 1
'Cut the first column of data from sheet2 and paste it into the second column of data in sheet3
'Cut 2
'Set0,6,12,18,24,30,36,42,48,54,60,66,72
Sheets("Sheet2").Select
Range(SourceRange2).Select
Selection.Cut
SourceRange2 = SourceRange2 + 2
'Paste 2
Sheets("Sheet7").Select
Range(DestinationRange).Select
ActiveSheet.Paste
DestinationRange = DestinationRange + 1
'Cut the second "used" column of data from sheet1 and paste it into the third column of data in sheet3
'Cut 1
'Set2,8,14,20,26,32,38,44,50,56,62,68,74
Sheets("Sheet1").Select
Range(SourceRange1).Select
Selection.Cut
SourceRange1 = SourceRange1 + 1
'Paste 1
Sheets("Sheet7").Select
Range(DestinationRange).Select
ActiveSheet.Paste
DestinationRange = DestinationRange + 1
'Cut the second "used" column of data from sheet2 and paste it into the fourth column of data in sheet3... This pattern continues...
'Cut 2
'Set2,8,14,20,26,32,38,44,50,56,62,68,74
Sheets("Sheet2").Select
Range(SourceRange2).Select
Selection.Cut
SourceRange2 = SourceRange2 + 1
'Paste 2
Sheets("Sheet7").Select
Range(DestinationRange).Select
ActiveSheet.Paste
DestinationRange = DestinationRange + 1
'Cut 1
'Set3,9,15,21,27,33,39,45,51,57,63,69,75
Sheets("Sheet1").Select
Range(SourceRange1).Select
Selection.Cut
SourceRange1 = SourceRange1 + 1
'Paste 1
Sheets("Sheet7").Select
Range(DestinationRange).Select
ActiveSheet.Paste
DestinationRange = DestinationRange + 1
'Cut 2
'Set3,9,15,21,27,33,39,45,51,57,63,69,75
Sheets("Sheet2").Select
Range(SourceRange2).Select
Selection.Cut
SourceRange2 = SourceRange2 + 1
'Paste 2
Sheets("Sheet7").Select
Range(DestinationRange).Select
ActiveSheet.Paste
DestinationRange = DestinationRange + 1
'Cut 1
'Set4,10,16,22,28,34,40,46,52,58,64,70,76
Sheets("Sheet1").Select
Range(SourceRange1).Select
Selection.Cut
SourceRange1 = SourceRange1 + 2
'Paste 1
Sheets("Sheet7").Select
Range(DestinationRange).Select
ActiveSheet.Paste
DestinationRange = DestinationRange + 1
'Cut 2
'Set4,10,16,22,28,34,40,46,52,58,64,70,76
Sheets("Sheet2").Select
Range(SourceRange2).Select
Selection.Cut
SourceRange2 = SourceRange2 + 2
'Paste 2
Sheets("Sheet7").Select
Range(DestinationRange).Select
ActiveSheet.Paste
DestinationRange = DestinationRange + 1

N = N + 1

Loop

p45cal
08-29-2018, 02:48 PM
This picture is of Sheet7, the result of running an adaptation of your code:
The blue text is the result of the first iteration of your loop, the black text is the second iteration of the loop.
Note the jump in two columns of the source data (C to E) in destination (Sheet7) columns D to E.
The same in the second iteration where source data jumps from column i to column K in sheet7's columns L to M
22799
If this pattern is wrong, supply a workbook with a similar Sheet7 with a row filled in in the same way for the whole lot, so that I can see where every column in Sheet7 gets its data from.

crthompson1
08-30-2018, 05:51 AM
This picture is of Sheet7, the result of running an adaptation of your code:
The blue text is the result of the first iteration of your loop, the black text is the second iteration of the loop.
Note the jump in two columns of the source data (C to E) in destination (Sheet7) columns D to E.
The same in the second iteration where source data jumps from column i to column K in sheet7's columns L to M
22799
If this pattern is wrong, supply a workbook with a similar Sheet7 with a row filled in in the same way for the whole lot, so that I can see where every column in Sheet7 gets its data from.

That pattern is correct. I'm sure it looks strange, but I'm trying to alternate extracting certain columns in a repeating pattern from two different sheets and paste them into sheet7 in consecutive order. The pattern increases 2 cells after the first column, 1 cell after the second, 1 cell after the third, and 2 cells after the fourth. Then the pattern repeats.

Paul_Hossler
08-30-2018, 08:54 AM
I used arySet generation, but the source columns can be automated to use how ever many columns there are, but this is the gist of it

No need to .Select the sheet or the range




Option Explicit
Sub test()
Dim arySet As Variant
Dim i As Long, o As Long

arySet = Array(3, 5, 6, 7, 9, 11, 12, 13)

o = 3

'change the .Copy to .Cut <<<<<<<<<<<<<<<<<<<<<<
For i = LBound(arySet) To UBound(arySet)
Worksheets("Sheet1").Cells(6, arySet(i)).Resize(73, 1).Copy _
Worksheets("Sheet7").Cells(6, o)
o = o + 1
Worksheets("Sheet2").Cells(6, arySet(i)).Resize(73, 1).Copy _
Worksheets("Sheet7").Cells(6, o)
o = o + 1

Next i
End Sub





or something along these lines.





Sub test2()

Dim i As Long, o As Long, n As Long, s As Long
Dim A As Variant

A = Array(2, 1, 1, 2) ' increment array
o = 3 ' output col
i = -1 ' increment array index
s = 3 ' source column

'change the .Copy to .Cut
For n = 1 To 13
Worksheets("Sheet1").Cells(6, s).Resize(73, 1).Copy _
Worksheets("Sheet7").Cells(6, o)
o = o + 1

Worksheets("Sheet2").Cells(6, s).Resize(73, 1).Copy _
Worksheets("Sheet7").Cells(6, o)
o = o + 1

i = i + 1
If i > UBound(A) Then i = LBound(A)

s = s + A(i)


Next n
End Sub

p45cal
08-30-2018, 09:45 AM
Paul's beaten me to it. Please feed back to say how you're getting on.
Paul, I'm doubtful you can change .Copy to .Cut (unless you activate the destination sheet and select the destination cell), I think you need to stay with .Copy but add a line each time of the ilk:
Worksheets("Sheet1").Cells(6, s).Resize(73, 1).ClearContents

Paul_Hossler
08-30-2018, 01:50 PM
@p45cal --


https://docs.microsoft.com/en-us/office/vba/api/excel.range.cut?f1url=https%3A%2F%2Fmsdn.microsoft.com%2Fquery%2Fdev11.quer y%3FappId%3DDev11IDEF1%26l%3Den-US%26k%3Dk(vbaxl10.chm144112)%3Bk(TargetFrameworkMoniker-Office.Version%3Dv16)%26rd%3Dtrue


Seems to work. The attachment is the results after running the second macro version

p45cal
08-30-2018, 04:18 PM
Yes Paul, you're quite right. I don't know what gave me that impression!
Thanks.

crthompson1
08-31-2018, 10:46 AM
I used arySet generation, but the source columns can be automated to use how ever many columns there are, but this is the gist of it

No need to .Select the sheet or the range






Option Explicit
Sub test()
Dim arySet As Variant
Dim i As Long, o As Long

arySet = Array(3, 5, 6, 7, 9, 11, 12, 13)

o = 3

'change the .Copy to .Cut <<<<<<<<<<<<<<<<<<<<<<
For i = LBound(arySet) To UBound(arySet)
Worksheets("Sheet1").Cells(6, arySet(i)).Resize(73, 1).Copy _
Worksheets("Sheet7").Cells(6, o)
o = o + 1
Worksheets("Sheet2").Cells(6, arySet(i)).Resize(73, 1).Copy _
Worksheets("Sheet7").Cells(6, o)
o = o + 1

Next i
End Sub





or something along these lines.





Sub test2()

Dim i As Long, o As Long, n As Long, s As Long
Dim A As Variant

A = Array(2, 1, 1, 2) ' increment array
o = 3 ' output col
i = -1 ' increment array index
s = 3 ' source column

'change the .Copy to .Cut
For n = 1 To 13
Worksheets("Sheet1").Cells(6, s).Resize(73, 1).Copy _
Worksheets("Sheet7").Cells(6, o)
o = o + 1

Worksheets("Sheet2").Cells(6, s).Resize(73, 1).Copy _
Worksheets("Sheet7").Cells(6, o)
o = o + 1

i = i + 1
If i > UBound(A) Then i = LBound(A)

s = s + A(i)


Next n
End Sub







Thanks for the response! I couldn't do an array because the amount of columns I would be copying won't be the same each time. I used the following to get my column number to increment in the pattern I wanted.


'Cut the first column of data from sheet1 and paste it into the first column of data in sheet7
'Cut 1
'Set0,6,12,18,24,30,36,42,48,54,60,66,72
X=0
Do Until X=10
Sheets("Sheet1").Select
SourceRange1.Select
SourceRange1.Copy
Sheets("Sheet7").Select
DestinationColumn.Select
ActiveSheet.Paste
Source1ColumnNumber = Source1ColumnNumber + 2
Sheets("Sheet1").Select
Set SourceRange1 = Sheets(1).Range(Cells(6, Source1ColumnNumber), Cells(78, Source1ColumnNumber))
DestinationColumnNumber = DestinationColumnNumber + 1
Sheets("Sheet7").Select
Set DestinationColumn = Sheets(7).Range(Cells(6, DestinationColumnNumber), Cells(78, DestinationColumnNumber))

Sheets("Sheet1").Select
SourceRange1.Select
SourceRange1.Copy
Sheets("Sheet7").Select
DestinationColumn.Select
ActiveSheet.Paste
Source1ColumnNumber = Source1ColumnNumber + 1
Sheets("Sheet1").Select
Set SourceRange1 = Sheets(1).Range(Cells(6, Source1ColumnNumber), Cells(78, Source1ColumnNumber))
DestinationColumnNumber = DestinationColumnNumber + 1
Sheets("Sheet7").Select
Set DestinationColumn = Sheets(7).Range(Cells(6, DestinationColumnNumber), Cells(78, DestinationColumnNumber))

Sheets("Sheet1").Select
SourceRange1.Select
SourceRange1.Copy
Sheets("Sheet7").Select
DestinationColumn.Select
ActiveSheet.Paste
Source1ColumnNumber = Source1ColumnNumber + 1
Sheets("Sheet1").Select
Set SourceRange1 = Sheets(1).Range(Cells(6, Source1ColumnNumber), Cells(78, Source1ColumnNumber))
DestinationColumnNumber = DestinationColumnNumber + 1
Sheets("Sheet7").Select
Set DestinationColumn = Sheets(7).Range(Cells(6, DestinationColumnNumber), Cells(78, DestinationColumnNumber))

Sheets("Sheet1").Select
SourceRange1.Select
SourceRange1.Copy
Sheets("Sheet7").Select
DestinationColumn.Select
ActiveSheet.Paste
Source1ColumnNumber = Source1ColumnNumber + 2
Sheets("Sheet1").Select
Set SourceRange1 = Sheets(1).Range(Cells(6, Source1ColumnNumber), Cells(78, Source1ColumnNumber))
DestinationColumnNumber = DestinationColumnNumber + 1
Sheets("Sheet7").Select
Set DestinationColumn = Sheets(7).Range(Cells(6, DestinationColumnNumber), Cells(78, DestinationColumnNumber))
X=X+1
Loop

Paul_Hossler
08-31-2018, 10:58 AM
1. Use CODE tags please -- the [#] icon will insert opening and closing CODE tags and you can paste your macro between them

2. You don't need to do all that .Select and Set to just Cut some data over

3. It seems you change the number of iterations each time:in post #1 it was 13, in post #8 it was 10

I think if you use test2() and manually change the 13 to 10, it should be the same

If the data on sheet1 and sheet2 is a contiguous block, there are more sophisticated ways to do it so that you don't need to manually update the macro