next column

[oldjay]

How do I select the 1st row in the next column after 16 that does not have
any text in row 1?

oldjay

 

[Rick Rothstein]

Like this maybe...

Cells(1, 16).Resize(1, Columns.Count - 15).Find("", LookAt:=xlWhole).Select

If there is any chance all the cells to the end of Row 1 are filled in, then
you will need to include some error trapping since the Find method will
error out there is nothing for it to find.

 

[OssieMac]

We meet again oldjay. Could become a habit.

Not really sure of what you want so here are 2 answers depending on the
meaning of your question.

If you mean the cell after the last cell with data and there are no more
cells in row 1 with data then the following finds the blank cell at the end
of the data.

Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).Select

If there is likely to be more cells with data after the first blank cell
then the following.

Dim i As Long

For i = 17 To Columns.Count
If IsEmpty(Cells(1, i)) Then
Cells(1, i).Select
Exit For
End If
Next i

 

[oldjay]

Thanks for all the help past and future

Again I didn't state everything. The following macro copies all columns in a
range to a single column (16). If after the copy to col16 I might run the
Macro again but i want to place all the cells in the next column. All column
to the right of 16 are blank. Each time I run the macro it should place all
the cells in the next empty column.

oldjay

Sub Move_Lists()
Dim NewRow As Long, NewColumn As Long
Dim X As Long
NewRow = 1
NewColumn = 16
For Col = 1 To 9
For X = 2 To 31
If Cells(X, Col) <> "" Then
Cells(NewRow, NewColumn).Value = Cells(X, Col).Value
NewRow = NewRow + 1
End If
Next
Next

End Sub

 

[Per Jessen]

Hi

Try this:

Sub Move_Lists()
Dim NewRow As Long, NewColumn As Long
Dim X As Long
NewRow = 1
NewColumn = 16
If Cells(NewRow, NewColumn).Value <> "" Then
NewColumn = Cells(1, Columns.Count).End(xlToLeft).Offset(0,
1).colunm
End If
For Col = 1 To 9
For X = 2 To 31
If Cells(X, Col) <> "" Then
Cells(NewRow, NewColumn).Value = Cells(X, Col).Value
NewRow = NewRow + 1
End If
Next
Next
End Sub

Regards.
Per

 

[OssieMac]

Hello again oldjay,

I don't know if the code that I have included to "Ensure first run of code
will start at column 16" is required or not. If you have any blank columns
between the end of your other data and column 16 then it is required but it
won't matter either way if it remains.

Sub Move_Lists()
Dim NewRow As Long
Dim NewColumn As Long
Dim Col As Long
Dim X As Long

NewRow = 1

'Use the following code to find first
'unused column
NewColumn = Cells(1, Columns.Count) _
.End(xlToLeft).Offset(0, 1).Column

'Ensure first run of code
'will start at column 16
If NewColumn < 16 Then
NewColumn = 16
End If

'NewColumn = 16 'Don't use this line

For Col = 1 To 9
For X = 2 To 31
If Cells(X, Col) <> "" Then
Cells(NewRow, NewColumn).Value = Cells(X, Col).Value
NewRow = NewRow + 1
End If
Next X
Next Col

End Sub

 

[oldjay]

Last thing (I hope)
I can't any way to also copy the formats.
Cells(NewRow, NewColumn).Value = Cells(X, Col).Value

 

[OssieMac]

Hi oldjay,

This same answer on your other post.

If you want both values and formats you need to copy the source and paste it
to the destination. The following line of code copies and pastes in the one
line of code.

Cells(X, Col).Copy Destination:=Cells(NewRow, NewColumn)

The code can actually be shortened to the following because Destination is
default parameter.

Cells(X, Col).Copy Cells(NewRow, NewColumn)