Double numbers

[olegvolf]

Hello,

I have this code that i am working with:

Public Sub COPYdimsfrom_TABLE() Sheets("data").Range("K1:N5000").ClearContents
 Dim RNG1 As Range


Set RNG1 = Sheets("table").UsedRange.Find("Part", , xlValues, xlPart)
If Not RNG1 Is Nothing Then
MsgBox "Found in column " & RNG1.Column
Else
MsgBox "Not found", vbCritical
End If
    ColNo = RNG1.Column
   MsgBox Split(Cells(, ColNo).Address, "$")(1)
   Collet = Split(Cells(, ColNo).Address, "$")(1)
    TEST_COLUMN = Collet  '<=== change to suit
   Dim i As Long
   Dim LastRow As Long
   Dim NextRow As Long
   NextRow = 2


   Dim serial As String


   With Sheets("TABLE")
        serial = InputBox("Supply the required Serial number")
        serial = Right((serial), 2)
      '  MsgBox Right((serial), 2)
        If serial> 0 Then
             
            LastRow = .Cells(.Rows.count, TEST_COLUMN).End(xlUp).Row
            For i = 1 To LastRow
               
               If InStr(1, (.Cells(i, Collet).Value), serial) Then
            
       LastRow = .Cells(.Rows.count, TEST_COLUMN).End(xlUp).Row
               .Cells(i, "b").Resize(, 600).Copy
               
              NextRow = NextRow + 1
               
         With Sheets("data")
            .Cells(NextRow, "k").PasteSpecial Paste:=xlPasteAll, Transpose:=True
            
         Sheets("DATA").Range("K:k").NumberFormat = "0.0000"
              End With
           End If
           
       Next i
       End If
   End With
  


   
End Sub

The macro is searching the column with the word "part" and then according to the inputted serial copies the data from the relevant row.
I have a problem with this when in the column i have 2 or 3 similar numbers.
How can i fix the code in order that the macro will take only the latest number in the column?

Thank you

Regards,
Oleg

[olegvolf]

I have additional code:

Sub Del()     
    Dim x               As Long
    Dim LastRow         As Long
     
    LastRow = Range("m6000").End(xlUp).Row
    For x = 1 To LastRow Step 1
    MsgBox x
        If Application.WorksheetFunction.CountIf(Range("m1:m" & x), Range("m" & x).Value) > 1 Then
            Range("m" & x).EntireRow.Delete
        End If
    Next x
     
End Sub

But still the code deletes the first numbers and not the latest.
Regards,
Oleg

[snb]

Sub M_snb()
    x3 = Application.Max([not(iserr(find("part",A1:a1000)))*row(A1:A1000)])
End Sub

[olegvolf]

Hello

Thank you for your replay.
Can you please explain the code?
Thank you

[snb]

Did you analyse it ?

[olegvolf]

Yes and it is working great.
Because of this if it not to hard explain to me please in order to understand.

Thanks
Oleg

[olegvolf]

Yes and it is working great.
Because of this if it not to hard explain to me please in order to understand.

Thanks
Oleg

Hello
i ran into a problem yesterday.
How can i change in your code the "part" with a variable?

Thanks

[snb]

Sub M_snb()
    [K1]="part"
    x3 = Application.Max([not(iserr(find(K1,A1:a1000)))*row(A1:A1000)])
End Sub

[olegvolf]

Sub M_snb()
    [K1]="part"
    x3 = Application.Max([not(iserr(find(K1,A1:a1000)))*row(A1:A1000)])
End Sub

Thank you so much.
Please take a few seconds to explain the code only if you can?
Regards

Oleg Volfson

[snb]

Please do not quote.