Loop to find next empty cell to the right not working.

[Casey]

Hi,
This routine enters selected data from a multicolumn Listbox into a
named range ("TakeOffHeaders"). The code successfully puts the correct
information in the correct cells with one exception. Instead of
selecting the first empty cell in the range it begins pasting the data
in a seemingly random column. Say the first empty column in the range
is “K” instead of starting there, it starts in column “P”. When I set a
Watch on CopyCol based on value changes, the first value is different
every time I run the routine. I need help.

Here’s the Code

Option Explicit
Private Sub cmdEnterSelection_Click()
Dim rng1 As Range
Dim rng2 As Range
Dim i As Long
Dim j As Long
Dim CopyCol As Long

Set rng1 = Sheets("Takeoff").Range("TakeOffHeaders")
Set rng2 = Sheets("Takeoff").Range("StartCell")
ActiveCell = rng2
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(0, 1).Select
Loop

CopyCol = ActiveCell.Column

For i = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Selected(i) Then
With rng1
..Cells(3, CopyCol).Value = ListBox1.List(i, 0)
..Cells(1, CopyCol).Value = ListBox1.List(i, 1)
..Cells(4, CopyCol).Value = ListBox1.List(i, 2)
..Cells(5, CopyCol).Value = ListBox1.List(i, 3)
End With
CopyCol = CopyCol + 1
End If
Next i
OptionButton2.Value = True
End Sub

 

[Jim Thomlinson]

You don't need to iterate through teh columns with a loop. Give this a try...

Set rng2 = Sheets("Takeoff").Range("StartCell").end(xlToRight).offset(0,1)

CopyCol = rng2.Column

or you could set copycolumn directly without range 2

CopyCol =
Sheets("Takeoff").Range("StartCell").end(xlToRight).offset(0,1).column

 

[Casey]

Jim,
Thanks for the reply, but I'm getting a runtime error 1004 and debug is
pointing to the CopyCol line.

Here is the code updated with your input.

Private Sub cmdEnterSelection_Click()
Dim rng1 As Range
Dim i As Long
Dim j As Long
Dim CopyCol As Long

Set rng1 = Sheets("Takeoff").Range("TakeOffHeaders")

CopyCol = Sheets("Takeoff").Range("StartCell").End(xlToRight).Offset(0,
1).Column '<<<<<<ERROR

For i = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Selected(i) Then
With rng1
..Cells(2, CopyCol).Value = ListBox1.List(i, 0)
..Cells(3, CopyCol).Value = ListBox1.List(i, 1)
..Cells(4, CopyCol).Value = ListBox1.List(i, 2)
..Cells(5, CopyCol).Value = ListBox1.List(i, 3)
End With
CopyCol = CopyCol + 1
End If
Next i
OptionButton2.Value = True
End Sub

 

[Casey]

Jim,
I have tried everything I know to get your suggestion to work. I'
getting a 424 error on every iteration I've tried. Below is my curren
code with various iterations I've tried commented out. I could reall
use some help.

Here is the code.

Option Explicit
Private Sub cmdEnterSelection_Click()
Dim rng1 As Range
Dim rng2 As Range
Dim i As Long
Dim j As Long
Dim CopyCol As Long

Set rng1 = Sheets("Takeoff").Range("TakeOffHeaders")
'Set rng2 = Sheets("Takeoff").Range("StartCell")
'<<<<<<<<<<<<<<<<<<<<<<< Different ways I have tried
Set CopyCol
Sheets("Takeoff").Range("StartCell").End(xlToRight).Offset(0
1).Column
'CopyCol = rng2.End(xlToRight).Offset(0, 1).Column 'without Se
statement
'CopyCol = rng2.End(xlToRight).Offset(0, 1).Columns(0, 0)'without Se
statement
'Set CopyCol = rng2.End(xlToRight).Offset(0, 1).Columns(0, 0)
For i = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Selected(i) Then
With rng1
.Cells(1, CopyCol).Value = ListBox1.List(i, 0)
.Cells(4, CopyCol).Value = ListBox1.List(i, 1)
.Cells(5, CopyCol).Value = ListBox1.List(i, 2)
.Cells(6, CopyCol).Value = ListBox1.List(i, 3)
End With
CopyCol = CopyCol + 1
End If
Next i
OptionButton2.Value = True
End Su