Urgent..TRICKY..How to find last entries of each row "Having different ranges"

[Gauraog]

Hi All, Im a begainer to VBA.

I like to to find a last 3 entries of each row .

eg. I have a Row A2:N2 which contains data.....similarly I have a data in cell A3toG3........A4:Z4...and so on till the last row which has data.

Data will be always start from Column A but not fixed where will it be ending. (Actually it will keep changing)

Basically each row will have data but its not fixed in which column it will be ending.

I want to copy last 3 entries of each row which has data. Can someone please give me a VBA code to perform this activity. Quick response much appreciated.

 

[L. Howard]

Hi Gauraog.

Give this a try.

You did not say where you wanted to copy to so I have included a line to copy to sheet 2 column F or to the same sheet column B.

If you copy to the same sheet then you should put a header in column B where you want the copies data to start. And where ever you copy on the same sheet you will need to copy the data BELOW the last row of the rows you are copying FROM. Otherwise the "last column" count will count the newly copied data columns and return errors. (See the line that is commented out.)

Which is to say don't copy way to the right of your current data to row 2 for instance. Goofy stuff will show up in the copied data.

Regards,
Howard

Option Explicit

Sub LastTrey()
Dim c As Range
Dim Lc As Long, Lr As Long
Dim Arng As Range
Dim lColumn As Long

Lr = Cells(Rows.Count, 1).End(xlUp).Row
Set Arng = Range("A1:A" & Lr)

For Each c In Arng

  Lc = Cells(c.Row, Columns.Count).End(xlToLeft).Column
  c.Offset(, (Lc - 3)).Resize(1, 3).Copy
  Sheets("Sheet2").Range("F" & Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues

  'Range("B" & Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues

Next

End Sub

 

[Rick Rothstein]

Small extension to above.....

I want that macro to be run for each sheet in workbook and values to be pasted in column lets say column P, Column Q and Column R of same sheet.

Can you please help on this?

This is how I would modify my code to do what you asked...

Sub GetLastThreeValuesPerRow()
  Dim R As Long, C As Long, LastRow As Long, LastColumn As Long, Counter As Long
  Dim Values As Variant, ArrIn As Variant, ArrOut As Variant, WS As Worksheet
  For Each WS In Worksheets
    LastRow = WS.Cells(Rows.Count, "A").End(xlUp).Row
    LastColumn = WS.Cells.Find(What:="*", SearchOrder:=xlByColumns, _
                 SearchDirection:=xlPrevious, LookIn:=xlValues).Column
    ArrIn = WS.Range("A1", Cells(LastRow, LastColumn))
    ReDim ArrOut(1 To UBound(ArrIn), 1 To 3)
    For R = 1 To UBound(ArrIn)
      Counter = 3
      For C = LastColumn To 1 Step -1
        If Counter = 0 Then Exit For
        If Len(ArrIn(R, C)) Then
          ArrOut(R, Counter) = ArrIn(R, C)
          Counter = Counter - 1
        End If
      Next
    Next
    WS.Range("P1").Resize(UBound(ArrOut), 3) = ArrOut
  Next
End Sub

 

[Gauraog]

Wow...its working......Thank you Rick and Thank you so much Mark......much appreciated.

 

[Gauraog]

Hi Gauraog.

Give this a try.

You did not say where you wanted to copy to so I have included a line to copy to sheet 2 column F or to the same sheet column B.

If you copy to the same sheet then you should put a header in column B where you want the copies data to start. And where ever you copy on the same sheet you will need to copy the data BELOW the last row of the rows you are copying FROM. Otherwise the "last column" count will count the newly copied data columns and return errors. (See the line that is commented out.)

Which is to say don't copy way to the right of your current data to row 2 for instance. Goofy stuff will show up in the copied data.

Regards,
Howard

Option Explicit

Sub LastTrey()
Dim c As Range
Dim Lc As Long, Lr As Long
Dim Arng As Range
Dim lColumn As Long

Lr = Cells(Rows.Count, 1).End(xlUp).Row
Set Arng = Range("A1:A" & Lr)

For Each c In Arng

  Lc = Cells(c.Row, Columns.Count).End(xlToLeft).Column
  c.Offset(, (Lc - 3)).Resize(1, 3).Copy
  Sheets("Sheet2").Range("F" & Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues

  'Range("B" & Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues

Next

End Sub

Thanks Howard, You are right. I was stuck at the same point "the last column count will count the newly copied data columns and return errors." Thank you for making me understand.

 

[MARK858]

"the last column count will count the newly copied data columns and return errors

If know the column you are posting to then rather than columns.count use the previous column (in this case bacause you are using column P then column O....

Sub TryAgain2()
    Dim C As Range, i As Long, WS As Worksheet
    For Each WS In ActiveWorkbook.Worksheets
        With WS
            For Each C In .Range("A1:A" & .Range("A" & Rows.Count).End(xlUp).Row)
                i = .Cells(C.Row, [COLOR="#FF0000"]"O"[/COLOR]).End(xlToLeft).Column
                If i > 2 Then
                    .Range(.Cells(C.Row, i - 2), .Cells(C.Row, i)).Copy .Cells(C.Row, "P")
                End If
            Next
        End With
    Next
End Sub

 

[Rick Rothstein]

Thanks Howard, You are right. I was stuck at the same point "the last column count will count the newly copied data columns and return errors." Thank you for making me understand.

Here is my code modified to stop at Column O (because the data is written to Column P)...

Sub GetLastThreeValuesPerRow()
  Dim R As Long, C As Long, LastRow As Long, Counter As Long
  Dim Values As Variant, ArrIn As Variant, ArrOut As Variant, WS As Worksheet
  For Each WS In Worksheets
    LastRow = WS.Cells(Rows.Count, "A").End(xlUp).Row
    ArrIn = WS.Range("A1", Cells(LastRow, "O"))
    ReDim ArrOut(1 To UBound(ArrIn), 1 To 3)
    For R = 1 To UBound(ArrIn)
      Counter = 3
      For C = LastColumn To 1 Step -1
        If Counter = 0 Then Exit For
        If Len(ArrIn(R, C)) Then
          ArrOut(R, Counter) = ArrIn(R, C)
          Counter = Counter - 1
        End If
      Next
    Next
    WS.Range("P1").Resize(UBound(ArrOut), 3) = ArrOut
  Next
End Sub

 

[L. Howard]

Very clever, Rick. There seems to be no end to the tricks you pro's can pull out of the bag.

Cheat sheet material, for sure.

Regards,
Howard

 

[MARK858]

Hi Rick is the code in post #16 running correctly for you ?
LastColumn in the line below doesn't appear to be assigned or declared anywhere?

For C = LastColumn To 1 Step -1

I would also think there should be another WS added as in the line below

ArrIn = WS.Range("A1", WS.Cells(LastRow, "O"))

 

[Rick Rothstein]

Hi Rick is the code in post #16 running correctly for you ?
LastColumn in the line below doesn't appear to be assigned or declared anywhere?

I would also think there should be another WS added as in the line below

You are correct on both counts! I did not test the code, rather, I tried to eye the changes in... AND SCREWED IT UP!

Thank you so much for catching that... I really appreciate it. I am going to correct the code for the OP right now.

 

[MARK858]

No problem, I should have said about the WS earlier when I spotted it in the original code but forgot. Apologies.