VBA or formula to move data in last used column to column A

[JPM]

I have a system generated report that, when imported into Excel, has financial data in the last used column of each row. However, the last column varies from row to row between columns B and P.
I created a simple macro that gets the job done, but takes a long time when the report get big, because it moves down row by row and does a copy and paste routine.
I'm looking for some faster solution, either VBA or even a formula that I can just copy down. Any ideas?
Here is my existing code:

Sub GetDataInLastColumn()
    'Purpose is to copy the data from the last used column into added column A
    Application.ScreenUpdating = False
    'Insert a new column A and highlight yellow
    Sheets("Copy").Select
    MaxRow = ActiveSheet.UsedRange.Rows.Count
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("A:A").Interior.Color = 65535
    Range("A1").Select
    'Find last used column and copy data to column A. Go row by row
Repeat:
    If ActiveCell.row > MaxRow Then GoTo Done
    Application.StatusBar = "The macro is running please wait...checking row " & ActiveCell.row & " of " & MaxRow
    ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate
    Cells(ActiveCell.row, "XFD").Select
    Selection.End(xlToLeft).Select
    Cost = ActiveCell.Formula
    Cells(ActiveCell.row, "A").Activate
    ActiveCell.Formula = Cost
GoTo Repeat
Done:
    Application.ScreenUpdating = True
    Application.StatusBar = ""
End Sub

Thanks

 

[Peter_SSs]

I suggest that you update your Account details (or click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)

See if this is a bit faster.
Also wondering if you really want/need the whole of the new column coloured? This just colours the part that is populated by the rest of the code.

Sub LastCol()
  Dim a As Variant
  Dim i As Long, j As Long, uba2 As Long
 
  Application.ScreenUpdating = False
  With Sheets("Copy")
    a = .UsedRange.Value
    uba2 = UBound(a, 2)
    .Columns("A").Insert
    Intersect(.UsedRange.EntireRow, .Columns("A")).Interior.Color = 65535
    For i = 1 To UBound(a)
      j = uba2
      Do While Len(a(i, j)) = 0 And j > 1
        j = j - 1
      Loop
      a(i, 1) = a(i, j)
    Next i
    .Range("A1").Resize(UBound(a)).Value = a
  End With
  Application.ScreenUpdating = True
End Sub

 

[myall_blues]

What about something like this?

Sub GetDataInLastColumn()
    Dim lastRow As Long, i As Long, lastCol As Long
    Dim rowArr As Variant
    Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("A:A").Interior.Color = 65535
    lastRow = Worksheets("Copy").Cells.Find("*", _
        SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For i = 1 To lastRow
        lastCol = Sheets("Copy").Range("B" & i).End(xlToRight).Column
        rowArr = Range(Cells(i, 2), Cells(i, lastCol))
        Range("A" & i).Value = rowArr(1, UBound(rowArr, 2))
    Next
End Sub

 

[JPM]

Peter_SSs and myall_blues, thank you both for your elegant solutions. When I timed my macro for my latest report of 1200+ rows, it took me 12.97 seconds to execute the routine. myall_blues solution got it done in 0.19 seconds and Peter_SSs in only 0.05 seconds. I certainly still have a lot to learn. Thanks for your help.

 

[myall_blues]

You’re welcome. I’m glad we were able to help.
You might like to investigate using arrays in VBA, which both our solutions make use of. Paul Kelly has some very good videos on the subject.

 

[Peter_SSs]

You're welcome. Thanks for the follow-up.

I don't know if your data will increase in size but if it does then the speed difference factor will also increase. In your example my code was about 4 times faster. With my testing with about 5,000 rows it was about 30 times faster.

BTW, you mentioned formulas and this could also be done with formulas. Insert the new column A yourself and put a formula like this in the top cell.
This is a smaller example but for my 5,000 row sample data, the recalculation time was just as fast as my vba code time.

JPM.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P
1	800873	833886	479018				302460	918129	906084	934561	133013	737023	152217	315740	511305	800873
2	152781	694432	680184	152781
3	365569	365569
4	450737	233201	581104	471010	483678	223345	246396	116155	346353	27497	505501	848001	834308	450737
5	338231	667883	990308	184905	183552	349575	515817	106319	374623	338231
6	312018	763310	219130	163700	610449	831923	56998	150462	815730	164440	89489	31931	361118	312018
7	51344															51344
8	613621	564652	625267	53416	186129				235785	613621
9	938128	588397	324896	986890	746111	25877	503279	417152	882384	315216	938128
10	287044	346035	698744	492012	657118	980488	505208	944476	894203	831715	702603	665388	417828	967393	752209	287044
11
12	34682	34682
13	817381	572411														817381
14	797331	293990	616887	851187	797331
15	82421	823731	705579	178678	82421
16	688092	702109	869374	948127	688092
17	661249	491944			661249
18	104164	104164
19	147468	136405			147468
20	800402	456615			800402
Copy (2)

Cell Formulas
Range	Formula
A1:A20	A1	=BYROW(B1:P20,LAMBDA(r,XLOOKUP("?*",r&"",r,"",2,-1)))
Dynamic array formulas.