Copy Values From 2 Columns To Next Available Row

[Jaye7]

Hi All,

I am after a script that would loop between columns C to column I.

The range is based on column A.

The columns (C-I) may not have values in certain cells, when they do I need to copy the value from Column C into the next available row in column A and also copy the same row value of column A into column B, so if a value was found in range("C3") then it would copy the value from C3 into the next empty row in column A and it would copy range("A3") value to column B next to where the C3 value was copied to.

I hope that this makes sense.

 

[Jaye7]

bump

 

[Anthony47]

You might try this macro:

Sub reall()
For I = 2 To Cells(Rows.Count, 3).End(xlUp).Row
If Cells(I, 3) <> "" Then
    Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Cells(I, 3)
    Cells(Rows.Count, 1).End(xlUp).Offset(0, 1).Value = Cells(I, 1)
End If
Next I
End Sub

Hope I got your points.

Bye

 

[Jaye7]

Hi Anthony,

The code works well for column C, however it doesn't seem to be working for the other columns, D has a lot more empty cells than C and E has a lot more empty cells than D etc... would this be effecting the outcome.

 

[Jaye7]

I think I know what is happening.

It copies C and A to A/B, however I shoud have stated better, when it checks column D it should copy the column D value to A and not the C value, so it would copy D3 and A3 to next available row if a value was found.

Column E it would copy E3 value and A3 value to next available row etc...

Sorry for the confusion.

If you could rectify the script it would be much appreciated.

 

[Anthony47]

With the new description:

Sub reall()
For J = 3 To 9 'Columns C to I
For I = 2 To Cells(Rows.Count, J).End(xlUp).Row
If Cells(I, J) <> "" Then
    Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Cells(I, J)
    Cells(Rows.Count, 1).End(xlUp).Offset(0, 1).Value = Cells(I, 1)
End If
Next I
Next J
End Sub

Bye

 

[Jaye7]

That's perfect, thanks very much Anthony.

Better than my complicated approach (that I started working on) based on the first script that you provided.

Sub test1()
For I = 2 To Cells(Rows.Count, 3).End(xlUp).Row
If Cells(I, 3) <> "" Then
    Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Cells(I, 3)
    Cells(Rows.Count, 1).End(xlUp).Offset(0, 1).Value = Cells(I, 1)
End If
Next I
For I = 3 To Cells(Rows.Count, 3).End(xlUp).Row
If Cells(I, 4) <> "" Then
    Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Cells(I, 4)
    Cells(Rows.Count, 1).End(xlUp).Offset(0, 1).Value = Cells(I, 1)
End If
Next I
For I = 4 To Cells(Rows.Count, 3).End(xlUp).Row
If Cells(I, 5) <> "" Then
    Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Cells(I, 5)
    Cells(Rows.Count, 1).End(xlUp).Offset(0, 1).Value = Cells(I, 1)
End If
Next I
 
End Sub

 

[Anthony47]

Loops have been invented to make things less complicated, indeed

Bye

 

[Jaye7]

Anthony,

Could you please provide a script that would column count rather than just columns C to I, it would count the columns just in case there were values in say columns J,K,L,M,N to Z etc... it would do the process for any columns from column C onwards that had a value in the cells.

Thanks

 

[Anthony47]

The following macro will step from column 3 onward until a completely empty column is found; it assumes that row 1 is used for headers (if any) and not for data.

Sub reallMany()
For J = 3 To Columns.Count
If Cells(Rows.Count, J).End(xlUp).Row < 2 Then Exit For  'empty column
For I = 2 To Cells(Rows.Count, J).End(xlUp).Row
If Cells(I, J) <> "" Then
    Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Cells(I, J)
    Cells(Rows.Count, 1).End(xlUp).Offset(0, 1).Value = Cells(I, 1)
End If
Next I
Next J
End Sub

Is that algorithm suitable for you?

Bye