Macro Help,

[mazher]

Hi All,

Please can some one help me with the macro.

I need to do the following tasks

Data starts from Column A till Column ADX
Row 1 is date
Row 2 below are the invoice numbers, In some columns there is only a row of data nd in some columns there are 150+ rows of data

I need to insert Column while at A1,
copy the value of B1 down ( which was previosuly A1, before adding the column) to A2 and copy tthat value down till the end of values in Coilumn B

Need to perform this task till the end of all columns

After that I need to stack all the data from all the columns into column A & B

Column A will be date and Column B willbe the Invoice Numbers.

I will be extremely thankful

 

[offthelip]

try this code which uses a couple of arrays to copy the data rather than inserting columns which will be rather slow, Using arrays is very fast:

Sub test()
Dim outarr()
lr = Cells.Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
inarr = Range("A1:ADX" & lr)

indi = 1  ' initalise output array index
ReDim outarr(1 To UBound(inarr, 1) * UBound(inarr, 2), 1 To 2) ' redimn output array to accomodate maximum size
For j = 1 To UBound(inarr, 2) ' loop through all columns
  dat = inarr(1, j) ' save the date
  For i = 2 To lr
   If inarr(i, j) <> "" Then
    outarr(indi, 1) = dat
    outarr(indi, 2) = inarr(i, j)
    indi = indi + 1
   Else
    Exit For
   End If
  Next i
Next j
With Worksheets("Sheet2")
 .Range(.Cells(1, 1), .Cells(indi, 2)) = outarr
End With
End Sub

Note I output the resuslt to sheet 2 just for testing , change with statement to the correct sheet

 

[mazher]

Thanks it works but when consolidating all the columns in column A & B , it is not clearing the contents of the other columns after consolidation.

 

[offthelip]

Just add a line to clear the whole sheet i.e.:

inarr = Range("A1:ADX" & lr)  ' AFTER this line add:
Range("A1:ADX" & lr)=""   ' add this line