Help with Macro selecting ranges

[KlayontKress]

To any reading this,


I'm looking for a way to dynamically copy and paste values from two separate ranges into another column. This is because we sell items either by a single color or as a dual color. For example, a customer could order all of their stuff (Wall and island) in color 1 or color 2, or they could order their Wall parts in color 1 and their island parts in color 2.

1st, I need a macro to look in column "A" to determine how long the first continuous range is. In my sheet it always starts at A7 but for this example, the first range would be from A2 to A4. I need the macro to then copy and paste the values from B2:B4 into D2:D4. I need it to look in column A first because a particular part may not be available in every color so there is a chace that there are blanks in the cost data in columns b, c, d, etc.

2nd, I need a macro to look in column "A" and find the range after the first blank cell below row 2. For example, the macro would look in column A and determine a dynamic range of cell A6:A7. I then need the macro to copy the data in C6:C7 into D6:D7

-----------------------

So far I have found a way to dynamically define the first continuous range for the Wall things using this formula

    Range("B2:B" & Range("B2").End(xlDown).Row).Select
    Selection.Copy

    Range("D2").Select
    ActiveSheet.Paste

I am struggling with adapting this to look at column a to determine the length of the range and then offset that to column B to copy the data there.


[TABLE="class: grid, width: 500, align: center"]
<tbody>[TR]
[TD][/TD]
[TD]A
[/TD]
[TD]B
[/TD]
[TD]C
[/TD]
[TD]D
[/TD]
[TD]E
[/TD]
[TD]F
[/TD]
[TD]G
[/TD]
[TD]H
[/TD]
[TD]I
[/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD][/TD]
[TD]Color 1
[/TD]
[TD]Color 2
[/TD]
[TD]Color 1 & 2
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]Wall Thing 1
[/TD]
[TD]130
[/TD]
[TD]97
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3
[/TD]
[TD]Wall Thing 2
[/TD]
[TD]341
[/TD]
[TD]190
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]4
[/TD]
[TD]Wall Thing 3
[/TD]
[TD]280
[/TD]
[TD]380
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]5
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]6
[/TD]
[TD]Island Thing 1
[/TD]
[TD]78
[/TD]
[TD]215
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]7
[/TD]
[TD]Island Thing 2
[/TD]
[TD]118
[/TD]
[TD]15
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]8
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]9
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]10
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]11
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]12
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]13
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]14
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]15
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]16
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]17
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]18
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]19
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]20
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]21
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]22
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]23
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]24
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

 

[KlayontKress]

I think I found a way to do the first part required using the following code. I'm not sure that it's the best way but it'll work

Dim a As Range
Set a = Range("A2:A" & Range("A2").End(xlDown).Row)
a.Offset(i, 1).Copy
    
Range("D2").Select
ActiveSheet.Paste

 

[KlayontKress]

I'm thinking that using some form of find last cell in column "A" and then selecting the continuous range above that might work but I'm struggling to code this. Any ideas?

 

[Fluff]

How about

Sub copyRngs()
'KlayontKress

    Dim Srw As Long
    Dim Erw As Long
    
    Erw = Range("A2").End(xlDown).Row
    With Range("D2").Resize(Erw)
        .Value = .Offset(, -2).Value
    End With
    Srw = Range("A" & Erw).End(xlDown).Row
    Erw = Range("A" & Srw).End(xlDown).Row
    With Range("D" & Srw).Resize(Erw)
        .Value = .Offset(, -1).Value
    End With

End Sub

 

[KlayontKress]

This seems to fit the bill.


much thanks

 

[Fluff]

Glad to help & thanks for the feedback