copy 4 columns into one, missing empty or #VALUE! cells

[dappy]

Hi folks,

i have 4 columns of data that vary in length to copy to one column and i cant figure out a loop to get the 2,3 or 4 columns copied to the bottom of the first

i have this so far

Dim x As Integer
Dim y As Integer
x = 1
y = 2
Do Until Worksheets("Sheet4").Range("A" & x) = ""
Worksheets("XML").Range("A" & y) = Worksheets("Sheet4").Range("A" & x)
y = y + 1
x = x + 1
Loop

any guidance much appreciated.

Carl

 

[Fluff]

Try replacing that last line with

   For r = 1 To j
      Sheets("XML").Range("A1").Offset(r).Value = Nary(r)
   Next r

 

[dappy]

Try replacing that last line with

   For r = 1 To j
      Sheets("XML").Range("A1").Offset(r).Value = Nary(r)
   Next r

thanks that did populated the first column of sheet4 into XML sheet but not columns B, c and d. is this right?

Sub CopyCols()
Dim Ary As Variant, Nary As Variant
Dim r As Long, c As Long, j As Long
Ary = Intersect(Sheets("sheet4").UsedRange, Sheets("sheet4").Range("A:D"))
ReDim Nary(1 To UBound(Ary, 1) * 4)
For c = 1 To UBound(Ary, 2)
For r = 1 To UBound(Ary, 1)
If Not IsEmpty(Ary(r, c)) And Not IsError(Ary(r, c)) Then
j = j + 1
Nary(j) = Ary(r, c)
End If
Next r
Next c
For r = 1 To j
Sheets("XML").Range("A1").Offset(r).Value = Nary(r)
Next r
End Sub

 

[Fluff]

Cols B to D should be in col A underneath the col A data.

 

[dappy]

Cols B to D should be in col A underneath the col A data.

morning, unfortunately not, there is no lines from col b, c or d at the bottom

 

[Fluff]

Pu this message box in as shown

   Next C
  [COLOR=#ff0000] MsgBox UBound(ary) & vbLf & UBound(Nary) & vbLf & j[/COLOR]
   For R = 1 To j

What does it say?

 

[dappy]

Pu this message box in as shown

   Next C
  [COLOR=#ff0000] MsgBox UBound(ary) & vbLf & UBound(Nary) & vbLf & j[/COLOR]
   For R = 1 To j

What does it say?

It shows


190
760
636

 

[Fluff]

Ok, what is the last used cell in sheets XML, colA?

 

[dappy]

Ok, what is the last used cell in sheets XML, colA?

Last used cell in XML columnA is 44

 

[Fluff]

Don't understand what is happening.

Would you be willing to upload your file to a share site & provide the link?

 

[Fluff]

How about

Sub CopyCols()
   Dim ary As Variant, Nary As Variant
   Dim R As Long, C As Long, j As Long
   ary = Intersect(Sheets("sheet4").UsedRange, Sheets("sheet4").Range("A:D"))
   ReDim Nary(1 To UBound(ary, 1) * 4)
   For C = 1 To UBound(ary, 2)
      For R = 1 To UBound(ary, 1)
         If Not IsError(ary(R, C)) Then
            If Not Len(ary(R, C)) = 0 Then
               j = j + 1
               Nary(j) = ary(R, C)
            End If
         End If
      Next R
   Next C
   For R = 1 To j
      Sheets("XML").Range("A1").Offset(R).Value = Nary(R)
   Next R
End Sub