Resize a row but copy but skip columns I don't want to copy

  • Thread starter Thread starter Howard
  • Start date Start date
H

Howard

With the resize in this segment of code, it copies col A and B. On that same row I want to also copy col D and F.

So the resize would be c.Offset(0, -1).Resize(1, col's A, B, D, F).Copy

Is that possible in a routine resize?

In this case it would always be those four columns, so I thinking those four columns will need to be in an array and then refer to the array in the resize?

I have been searching my archives for something like this but coming up short.

Thanks.
Howard

lRow = Cells(Rows.Count, 2).End(xlUp).Row
Set bRng = Range("B14:B" & lRow)

For Each c In bRng
If c.Value <> "" Then
c.Offset(0, -1).Resize(1, 2).Copy
Worksheets("Invoice Data").Range("C100").End(xlUp).Offset(1, 0).PasteSpecial
End If
Next
 
Hi Howard,

Am Fri, 30 Aug 2013 00:22:14 -0700 (PDT) schrieb Howard:
With the resize in this segment of code, it copies col A and B. On that same row I want to also copy col D and F.

So the resize would be c.Offset(0, -1).Resize(1, col's A, B, D, F).Copy

Is that possible in a routine resize?
Click to expand...

resize works only with adjacent cells.
Try:

lRow = Cells(Rows.Count, 2).End(xlUp).Row
Set bRng = Range("B14:B" & lRow)
myArr = Array(1, 2, 4, 6)

For Each c In bRng
If c.Value <> "" Then
lRow = Worksheets("Invoice Data"). _
Cells(Rows.Count, 3).End(xlUp).Row + 1
For i = LBound(myArr) To UBound(myArr)
Worksheets("Invoice Data").Cells(lRow, i + 3) _
= Cells(c.Row, myArr(i))
Next
End If
Next

Or with another For-Next statement:

lRow = Cells(Rows.Count, 2).End(xlUp).Row
Set bRng = Range("B14:B" & lRow)

For Each c In bRng
If c.Value <> "" Then
lRow = Worksheets("Invoice Data"). _
Cells(Rows.Count, 3).End(xlUp).Row + 1
j = 5
c.Offset(0, -1).Resize(, 2).Copy _
Worksheets("Invoice Data").Range("C" & lRow)
For i = 4 To 6 Step 2
Cells(c.Row, i).Copy _
Worksheets("Invoice Data").Cells(lRow, j)
j = j + 1
Next
End If
Next


Regards
Claus B.
 
Set bRng = Range("B14:B" & lRow)
myArr = Array(1, 2, 4, 6)



For Each c In bRng

If c.Value <> "" Then

lRow = Worksheets("Invoice Data"). _

Cells(Rows.Count, 3).End(xlUp).Row + 1

For i = LBound(myArr) To UBound(myArr)

Worksheets("Invoice Data").Cells(lRow, i + 3) _

= Cells(c.Row, myArr(i))

Next

End If

Next
Click to expand...

Hi Claus.

Using the above.

I get an error "expected an array" with the LBound blue highlighted.
For i = LBound(myArr)

Have I dimmed these correctly?

Dim myArr As Range
Dim j As Range
Dim i As Long

Howard
 
Hi Howard,

Am Fri, 30 Aug 2013 01:44:45 -0700 (PDT) schrieb Howard:
Dim myArr As Range
Dim j As Range
Dim i As Long
Click to expand...

try:
Dim myArr As Variant
Dim i As Integer

j is not needed


Regards
Claus B.
 
Hi Howard,



Am Fri, 30 Aug 2013 01:44:45 -0700 (PDT) schrieb Howard:








try:

Dim myArr As Variant

Dim i As Integer



j is not needed





Regards

Claus B.

--

Win XP PRof SP2 / Vista Ultimate SP2

Office 2003 SP2 /2007 Ultimate SP2
Click to expand...

Okay, not sure why I included j. It's in the other code you posted but so far I've only copied the first.

Howard
 
Hi Howard,



Am Fri, 30 Aug 2013 01:44:45 -0700 (PDT) schrieb Howard:








try:

Dim myArr As Variant

Dim i As Integer



j is not needed





Regards

Claus B.
Click to expand...

Smooth as silk!

Thanks a bunch Claus.

Regards,
Howard
 
Hi Howard,

Am Fri, 30 Aug 2013 01:58:35 -0700 (PDT) schrieb Howard:
Smooth as silk!
Click to expand...

instead of writing in the 4 cells you can write it in an array and write
back in a range:

Dim lRow As Long
Dim rngC As Range
Dim bRng As Range
Dim c As Range
Dim myArr As Variant
Dim varOut() As Variant
Dim i As Integer

lRow = Cells(Rows.Count, 2).End(xlUp).Row
Set bRng = Range("B14:B" & lRow)
myArr = Array(1, 2, 4, 6) 'Column numbers

For Each c In bRng
If c.Value <> "" Then
Set rngC = Worksheets("Invoice Data"). _
Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)
For i = LBound(myArr) To UBound(myArr)
ReDim Preserve varOut(i)
varOut(i) = Cells(c.Row, myArr(i))
Next
rngC.Resize(, 4) = varOut
End If
Next


Regards
Claus B.
 
Back
Top