VB coding required to list text

[RSEKAR]

Dear Sir
I have text in A and B column. For example in A column in the rows 2,4,5,7 contain text. In B column the rows 1,4,5,8 contain text. I want these two column text are to be placed in the C column one by one from 1-8 rows with one condition the A column text should occupy in the same row in the C column. The B column text can occupy any where in the C column.
I request some one to help me.

Thanking you once again.
RSEKAR

 

[NeonRedSharpie]

Sub moveText()
    Cells(1, 3).EntireColumn.Value = Cells(1, 1).EntireColumn.Value
    
    For x = 1 To Cells(Rows.Count, "B").End(xlUp).Row
        If Cells(x, 2) <> "" Then Cells(Cells(Rows.Count, "C").End(xlUp).Row + 1, 3) = Cells(x, 2)
    Next x
End Sub

 

[RSEKAR]

Sub moveText()
    Cells(1, 3).EntireColumn.Value = Cells(1, 1).EntireColumn.Value
    
    For x = 1 To Cells(Rows.Count, "B").End(xlUp).Row
        If Cells(x, 2) <> "" Then Cells(Cells(Rows.Count, "C").End(xlUp).Row + 1, 3) = Cells(x, 2)
    Next x
End Sub

Dear Sir,
It is working fine. A column text are placed in the same row in C column and B column text are placed in the C column at the end. I need the C column text should be placed one by one from the first row so that we will not get empty cells from top to bottom of the list. As I said in my example the texts should occupy 1- 8 rows in the C column and the A column text in the same row in the C column. Can you suggest any solution?
Thanking you in advance.
RSEKAR

 

[NeonRedSharpie]

Sub moveText()    Cells(1, 3).EntireColumn.Value = Cells(1, 1).EntireColumn.Value
    
    Dim endrow As Integer
    Dim vals() As Variant
    Dim arrC As Integer
    Dim nextVal As Integer
    Dim valPlace As Integer
    
    nextVal = 1
    valPlace = 1
    
    arrC = Application.WorksheetFunction.CountA(Columns(2))
    endrow = Application.WorksheetFunction.Max( _
        Cells(Rows.Count, "A").End(xlUp).Row, _
        Cells(Rows.Count, "B").End(xlUp).Row)
    ReDim Preserve vals(1 To arrC)
    
    For x = 1 To endrow
        If Cells(x, 2) <> "" Then
            vals(nextVal) = Cells(x, 2)
            nextVal = nextVal + 1
        End If
    Next x
    
    
    
    For x = 1 To endrow
        If Cells(x, 3) = "" Then
            Cells(x, 3) = vals(valPlace)
            valPlace = valPlace + 1
        End If
    Next x
End Sub

You mentioned that it didn't matter where the column B data went so I placed it at the end. This code will fill in the blanks with column B data.

 

[RSEKAR]

Sub moveText()    Cells(1, 3).EntireColumn.Value = Cells(1, 1).EntireColumn.Value
    
    Dim endrow As Integer
    Dim vals() As Variant
    Dim arrC As Integer
    Dim nextVal As Integer
    Dim valPlace As Integer
    
    nextVal = 1
    valPlace = 1
    
    arrC = Application.WorksheetFunction.CountA(Columns(2))
    endrow = Application.WorksheetFunction.Max( _
        Cells(Rows.Count, "A").End(xlUp).Row, _
        Cells(Rows.Count, "B").End(xlUp).Row)
    ReDim Preserve vals(1 To arrC)
    
    For x = 1 To endrow
        If Cells(x, 2) <> "" Then
            vals(nextVal) = Cells(x, 2)
            nextVal = nextVal + 1
        End If
    Next x
    
    
    
    For x = 1 To endrow
        If Cells(x, 3) = "" Then
            Cells(x, 3) = vals(valPlace)
            valPlace = valPlace + 1
        End If
    Next x
End Sub

You mentioned that it didn't matter where the column B data went so I placed it at the end. This code will fill in the blanks with column B data.

Dear Sir,
Sorry I am disturbing you. The macro stops with error message as “subscript out of range”. And the code line below gets high lighted.
Cells(x, 3) = vals(valPlace)
Thanking you in advance.
RSEKAR

 

[NeonRedSharpie]

Sub moveText()
    Cells(1, 3).EntireColumn.Value = Cells(1, 1).EntireColumn.Value
    
    Dim endrow As Integer
    Dim vals() As Variant
    Dim arrC As Integer
    Dim nextVal As Integer
    Dim valPlace As Integer
    
    nextVal = 1
    valPlace = 1
    
    arrC = Application.WorksheetFunction.CountA(Columns(2))
    endrow = Application.WorksheetFunction.Max( _
        Cells(Rows.Count, "A").End(xlUp).Row, _
        Cells(Rows.Count, "B").End(xlUp).Row)
    ReDim Preserve vals(1 To arrC)
    
    For x = 1 To endrow
        If Cells(x, 2) <> "" Then
            vals(nextVal) = Cells(x, 2)
            nextVal = nextVal + 1
        End If
    Next x
    
    For x = 1 To endrow
        If Cells(x, 3) = "" Then
            On Error GoTo endme
            Cells(x, 3) = vals(valPlace)
            valPlace = valPlace + 1
        End If
    Next x
    
endme:
    
End Sub

Try that one. I guess sometimes it adds outside of the array. That should fix it.

 

[RSEKAR]

Sub moveText()
    Cells(1, 3).EntireColumn.Value = Cells(1, 1).EntireColumn.Value
    
    Dim endrow As Integer
    Dim vals() As Variant
    Dim arrC As Integer
    Dim nextVal As Integer
    Dim valPlace As Integer
    
    nextVal = 1
    valPlace = 1
    
    arrC = Application.WorksheetFunction.CountA(Columns(2))
    endrow = Application.WorksheetFunction.Max( _
        Cells(Rows.Count, "A").End(xlUp).Row, _
        Cells(Rows.Count, "B").End(xlUp).Row)
    ReDim Preserve vals(1 To arrC)
    
    For x = 1 To endrow
        If Cells(x, 2) <> "" Then
            vals(nextVal) = Cells(x, 2)
            nextVal = nextVal + 1
        End If
    Next x
    
    For x = 1 To endrow
        If Cells(x, 3) = "" Then
            On Error GoTo endme
            Cells(x, 3) = vals(valPlace)
            valPlace = valPlace + 1
        End If
    Next x
    
endme:
    
End Sub

Try that one. I guess sometimes it adds outside of the array. That should fix it.

Dear Sir,
Thanks a lot. It is working fine.
Thanking you once again,
RSEKARMD