Thread: Move data that accomplished specific conditions

Hello!!!

Hopefully someone can help me out!
I am working on a small project using visual basic and excel. I got a list of names in range A10 to A200, in front of them there is a number, 1, 2 or 3 that represent the 3 different categories that I have. Names never change their location, but numbers do. So, what I want to do is run a macro that first copy all names that have the number 1 and paste them in a different place, let’s say C1, then the same for all names that have number 2 into D1 and finally the same for names with number 3 into E1. I am sure there is a way to do it, I have been playing with different formulas and tried different macros, but without any success. I am all frustrated already, please help!!!!! Thanks in advance for your help!!

Hi gabrielmarmil

Welcome to the forum

Try this in a standard module or try the demo workbook attached

Option Explicit

Sub TransferByFirstDigit()
    Dim LastRow As Long
    Dim NextRowC As Long: NextRowC = 10
    Dim NextRowD As Long: NextRowD = 10
    Dim NextRowE As Long: NextRowE = 10
    Dim NextRowF As Long: NextRowF = 10
    Dim BlankRows As Long: BlankRows = 0
    Dim i As Integer
    
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    
    For i = 10 To LastRow
        Select Case Left(Range("A" & i), 1)
            Case "1"
                Range("C" & NextRowC) = Range("A" & i)
                NextRowC = NextRowC + 1
            Case "2"
                Range("D" & NextRowD) = Range("A" & i)
                NextRowD = NextRowD + 1
            Case "3"
                Range("E" & NextRowE) = Range("A" & i)
                NextRowE = NextRowE + 1
            Case Else
                If Range("A" & i) <> "" Then
                    Range("F" & NextRowF) = Range("A" & i)
                    NextRowF = NextRowF + 1
                Else
                    BlankRows = BlankRows + 1
                End If
        End Select
    Next
    If BlankRows > 0 Then Range("G10") = BlankRows & " Cell(s) Empty"
End Sub

Hope this helps.

If you need any further information, please feel free to ask further

However

If this takes care of your needs, please click EDIT in your original post, click GO ADVANCED and set the PREFIX box to SOLVED. It helps everybody!
Also
If you are satisfied by any members response to your problem please consider using the scales icon top right of thier post to show your appreciation.