Some help using If-Then Statement

[Davealot]

Greetings,
Hopefully someone can point me in the right direction, I have a list of around 200 part numbers with the first five characters being either "76200" or "76250". I'm attempting to automate reporting. I've use a macro recorder to do everything I need with the exception being that I need every part number that starts with "76250" to be placed in column E, starting in cell E2, and every part number that starts with "76200" being left alone in column A. I'm trying to work through using If-Then coupled with the right function to logically test which column the part number belongs in and I need to pull the coordinating data in the next two columns with said part number should it need to be placed in column E.

I've attached a sample worksheet to hopefully clear up what I'm looking for. Thanks in advance for any and all help my friends, it is much appreciated.

 

[Davealot]

Also, I should mention, this would be used in a daily order, so the part numbers will vary in amount that is on the list and location, so I need it to just examine the entire column, thanks.

 

[chirayu]

Sub Col_E()

Dim CurrRow As Integer

Range("A2").Select
Do Until IsEmpty(ActiveCell)
    If Left(ActiveCell, 5) = "76250" Then
        CurrRow = ActiveCell.Row
        Range("A" & CurrRow & ":C" & CurrRow).Copy
        Range("E" & Cells(Rows.Count, "E").End(xlUp).Offset(1, 0).Row).Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        Range("A" & CurrRow & ":C" & CurrRow).Select
        Selection.Delete shift:=xlUp
        Range("A" & CurrRow).Select
    Else
        ActiveCell.Offset(1, 0).Select
    End If
Loop
Range("A1").Select
MsgBox "Macro completed", vbInformation, ""

End Sub

 

[Marc L]

Hi !

Fastest way :​

Sub Demo()
    Application.ScreenUpdating = False
With Sheet3.Cells(1).CurrentRegion.Resize(, 4)
    .Columns(4).Formula = "=LEFT(A1,5)=""76250"""
    .Sort .Cells(4), xlAscending, Header:=xlYes
    V = Application.Match(True, .Columns(4), 0)
    .Columns(4).Clear
    If IsNumeric(V) Then .Rows(V & ":" & .Rows.Count).Resize(, 3).Cut .Parent.[E2]
End With
    Application.ScreenUpdating = True
End Sub

Do you like it ? So thanks to click on bottom right Like !
​

 

[Davealot]

Thanks Gents! Worked like a charm!

 

[shrivallabha]

One more idea that works on your test data. Posted just for idea.

Public Sub OneMoreRollOut()
Dim lngLastRow As Long
lngLastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("A2:C" & lngLastRow).Copy Range("E2")
With Range("A2:A" & lngLastRow)
    .Replace "76250" & "*", ""
    With .SpecialCells(xlCellTypeBlanks)
        .Offset(0, 2).Delete xlUp
        .Offset(0, 1).Delete xlUp
        .Delete xlUp
    End With
End With
With Range("E2:E" & lngLastRow)
    .Replace "76200" & "*", ""
    With .SpecialCells(xlCellTypeBlanks)
        .Offset(0, 2).Delete xlUp
        .Offset(0, 1).Delete xlUp
        .Delete xlUp
    End With
End With
End Sub