VBA Code to Find Last Row

[Justinian]

I have a list of apartment codes (e.g., 87-8703A) in range A2:A8. In cell J2, I used =RIGHT(A2,LEN(A2)-FIND("-",A2,1)) to extract the second part of the apartment code after the dash, giving me 8703A. I then copied the formula down to J8 and did paste special (values) into range A2:A8 and then centered the result horizontally and vertically. Everything works perfectly assuming my data is only in range A2:A8 but today, my data was in range A2:A13, so my macro only goes down to A8. How do I change the following code so that the macro finds the las row of data for both column J and column A?

Sub Extract()
Range("J2").Select
Selection.FormulaR1C1 = "=RIGHT(RC[-9],LEN(RC[-9])-FIND(""-"",RC[-9],1))"
Selection.AutoFill Destination:=Range("J2:J8")
Range("J2:J8").Select
Selection.Copy
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("J:J").Select
Selection.ClearContents
Range("A1").Select
End Sub

 

[Joe4]

Not sure why you are clearing column J at the end after doing all of that, but try this (which I think should do everything except clear column J):

Sub Extract()

    Dim lr As Long
    
'   Find last row with data in column A
    lr = Cells(Rows.Count, "A").End(xlUp).Row

'   Apply the following to all data rows in column J
    With Range("J2:J" & lr)
'       Formula
        .FormulaR1C1 = "=RIGHT(RC[-9],LEN(RC[-9])-FIND(""-"",RC[-9],1))"
'       Convert to values
        .Value = .Value
'       Formatting
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
    End With
    
End Sub

 

[Justinian]

I am clearing column J because the result is being copied and pasted (values) into column A so J is redundant. When I apply your code, changing J to A, I get a value error.

 

[Joe4]

OK, I think I see what you are doing. Try this:

Sub Extract()

    Dim lr As Long
    
'   Find last row with data in column A
    lr = Cells(Rows.Count, "A").End(xlUp).Row

'   Apply the following to all data rows in column J
    With Range("J2:J" & lr)
'       Formula
        .FormulaR1C1 = "=RIGHT(RC[-9],LEN(RC[-9])-FIND(""-"",RC[-9],1))"
'       Convert to values
        .Value = .Value
'       Formatting
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
    End With
    
'   Copy to column A and remove
    Range("J2:J" & lr).Copy Range("A2:A" & lr)
    Range("J2:J" & lr).ClearContents
    
End Sub

 

[Justinian]

Sorry if i was not clear.

That is working now - thank you!

 

[Joe4]

You are welcome.

 

[Rick Rothstein]

The following macro will do what you asked for directly without involving Column J or any copy/pasting...

Sub Extract()
  With Range("A2", Cells(Rows.Count, "A").End(xlUp))
    .Value = Evaluate(Replace("IF({1},REPLACE(@,1,FIND(""-"",@),""""))", "@", .Address))
  End With
End Sub