Macro To Take Date Only From The Furthest Right Hand Column Of Rows

[CONFUSED_AS_USUAL]

Self explanatory, but for clarity...



1. Row 1 has 5 columns of data (A to E). I want only the 5th column data. The rest is to be deleted. That 5th column data would now be in column A.

2. Row 2 has 10 columns of data (A to J). I want only the 10th column data. The rest is to be deleted. That 10th column data would now be in column A.

3 Row 3 has 1 column of data. It remains where it is.


There could be thousands of rows and dozens of columns.

Thanks.

 

[Fluff]

How about

Sub DeleteAllButLastCol()

   Dim Cnt As Long
   
   For Cnt = 1 To Range("A" & Rows.Count).End(xlUp).Row
      Range(Cells(Cnt, 1), Cells(Cnt, Columns.Count).End(xlToLeft).Offset(, -1)).Delete xlToLeft
   Next Cnt
   
End Sub

 

[CONFUSED_AS_USUAL]

Close... it worked on the 1st 3 columns below - but not the fourth.


[TABLE="width: 1024"]
<colgroup><col width="64" span="16" style="width:48pt"> </colgroup><tbody>[TR]
[TD="width: 64"]aa[/TD]
[TD="width: 64"]ss[/TD]
[TD="width: 64"]dd[/TD]
[TD="width: 64"]fh[/TD]
[TD="width: 64"]j[/TD]
[TD="width: 64"]k[/TD]
[TD="width: 64"]k[/TD]
[TD="width: 64"];'[/TD]
[TD="width: 64"]h[/TD]
[TD="width: 64"][/TD]
[TD="width: 64"][/TD]
[TD="width: 64"][/TD]
[TD="width: 64"][/TD]
[TD="width: 64"][/TD]
[TD="width: 64"][/TD]
[TD="width: 64"][/TD]
[/TR]
[TR]
[TD]g[/TD]
[TD]h[/TD]
[TD]hfd[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]df[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]hsdf[/TD]
[TD]fg[/TD]
[TD]hsdf[/TD]
[TD]fg[/TD]
[TD]hsdf[/TD]
[TD]fg[/TD]
[TD]hsdf[/TD]
[TD]fg[/TD]
[TD]hsdf[/TD]
[TD]fg[/TD]
[TD]hsdf[/TD]
[TD]fg[/TD]
[TD]hsdf[/TD]
[TD]fg[/TD]
[TD]hsdf[/TD]
[TD]fg[/TD]
[/TR]
</tbody>[/TABLE]

 

[Fluff]

I assume you meant it doesn't work on the 3rd row, in which case try

Sub DeleteAllButLastCol()

   Dim Cnt As Long
   Dim UsdCols As Long
   
   For Cnt = 1 To Range("A" & Rows.Count).End(xlUp).Row
      UsdCols = Cells(Cnt, Columns.Count).End(xlToLeft).Column
      If UsdCols > 1 Then Range(Cells(Cnt, 1), Cells(Cnt, UsdCols - 1)).Delete xlToLeft
   Next Cnt
   
End Sub

 

[CONFUSED_AS_USUAL]

That's correct. Works perfectly now.

Many Thanks !

 

[Fluff]

Glad to help & thanks for the feedback