I have a column of numbers, the first being a date and the second a value,
etc..
I want to take every other value (the even numbered rows) and move them to a
second column next to the date. Of course I'll end up with a blank every
other row, so I'll then want to "collapse" the columns to eliminate the
blanks.
Any easy way to do this as I have several thousand pieces of data.
Thanks in advance.,

Stephen

Hi Stephen,

'================
Public Sub Tester001()
Dim WB As Workbook
Dim SH As Worksheet
Dim Rng As Range
Dim LastRow As Long
Dim i As Long

Set WB = Workbooks("YourBook.xls") '<<===== CHANGE
Set SH = WB.Sheets("Sheet1") '<<===== CHANGE

LastRow = SH.Cells(Rows.Count, "A").End(xlUp).Row
Set Rng = SH.Range("A1:A" & LastRow)

Application.ScreenUpdating = False

For i = 1 To Rng.Rows.Count Step 2
Cells(i, 2).Value = Cells(i + 1, 1).Value
Next i

Rng.Offset(, 1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Application.ScreenUpdating = False

End Sub
'<<================


---
Regards,
Norman


"sek0910" wrote in message
...
I have a column of numbers, the first being a date and the second a value,
etc..
I want to take every other value (the even numbered rows) and move them to
a
second column next to the date. Of course I'll end up with a blank every
other row, so I'll then want to "collapse" the columns to eliminate the
blanks.
Any easy way to do this as I have several thousand pieces of data.
Thanks in advance.,

Stephen

Thanks..the first part works great, but the following line:

Rng.Offset(, 1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

appears to erase everything in the worksheet!

Once the values in the even numbered rows are moved to Column B of the odd
numbered rows, I just want to then delete all the even numbered rows and move
each lower row up so there will be no blank rows in the worksheet.

steve

"Norman Jones" wrote:

Hi Stephen,

'================
Public Sub Tester001()
Dim WB As Workbook
Dim SH As Worksheet
Dim Rng As Range
Dim LastRow As Long
Dim i As Long

Set WB = Workbooks("YourBook.xls") '<<===== CHANGE
Set SH = WB.Sheets("Sheet1") '<<===== CHANGE

LastRow = SH.Cells(Rows.Count, "A").End(xlUp).Row
Set Rng = SH.Range("A1:A" & LastRow)

Application.ScreenUpdating = False

For i = 1 To Rng.Rows.Count Step 2
Cells(i, 2).Value = Cells(i + 1, 1).Value
Next i

Rng.Offset(, 1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Application.ScreenUpdating = False

End Sub
'<<================


---
Regards,
Norman


"sek0910" wrote in message
...
I have a column of numbers, the first being a date and the second a value,
etc..
I want to take every other value (the even numbered rows) and move them to
a
second column next to the date. Of course I'll end up with a blank every
other row, so I'll then want to "collapse" the columns to eliminate the
blanks.
Any easy way to do this as I have several thousand pieces of data.
Thanks in advance.,

Stephen

Hi Steve,

Try the following version:

'================
Public Sub Tester001()
Dim WB As Workbook
Dim SH As Worksheet
Dim rng As Range
Dim delRng As Range
Dim LastRow As Long
Dim i As Long

Set WB = Workbooks("YourBook.xls") '<<===== CHANGE
Set SH = WB.Sheets("Sheet1") '<<===== CHANGE

LastRow = SH.Cells(Rows.Count, "A").End(xlUp).Row
Set rng = SH.Range("A1:A" & LastRow)

Application.ScreenUpdating = False

SH.Columns(2).Insert
For i = 1 To rng.Rows.Count Step 2
Cells(i, 2).Value = Cells(i + 1, 1).Value
If delRng Is Nothing Then
Set delRng = Cells(i + 1, 1).Resize(1, 2)
Else
Set delRng = Union(Cells(i + 1, 1). _
Resize(1, 2), delRng)
End If
Next i

delRng.Delete shift:=xlUp
Application.ScreenUpdating = False

End Sub
'<<================


---
Regards,
Norman



"sek0910" wrote in message
...
Thanks..the first part works great, but the following line:

Rng.Offset(, 1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

appears to erase everything in the worksheet!

Once the values in the even numbered rows are moved to Column B of the odd
numbered rows, I just want to then delete all the even numbered rows and
move
each lower row up so there will be no blank rows in the worksheet.

steve