estatefinds
07-14-2017, 06:36 AM
I have data that is in column C that is numeric with dashes. I need the macro Columns to rows to be able to take this data that is found in the cell and move it to the Row.
Currently the macro on works with just numeric data, but not numeric data with "-" in between the numerica data.
So I need the macro to be able to do what it suppossed to as it does now but be able to work with the data in column C you ll find on the excell sheet that I attach.
Thank you very much!!! in advance
Sincerely Dennis
Sub movetocolumns()Dim i As Integer, iRow As Integer
Dim arrSource As Variant
'Set the first row
iRow = 1
With ActiveWorkbook.Worksheets("Sheet1")
'get the data into an array from the first column
arrSource = Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
'parse every value of the array and add the data to the next column
For i = 1 To (UBound(arrSource) - UBound(arrSource) Mod 3) Step 3
.Cells(iRow, 2) = arrSource(i, 1)
.Cells(iRow, 3) = arrSource(i + 1, 1)
.Cells(iRow, 4) = arrSource(i + 2, 1)
iRow = iRow + 1
Next i
'add the remaining values
Select Case UBound(arrSource) Mod 3
Case 1 'one item to add
.Cells(iRow, 2) = arrSource(i, 1)
Case 2 'still two items to add
.Cells(iRow, 2) = arrSource(i, 1)
.Cells(iRow, 3) = arrSource(i + 1, 1)
Case Else 'nothing to add
End Select
End With
End Sub
Currently the macro on works with just numeric data, but not numeric data with "-" in between the numerica data.
So I need the macro to be able to do what it suppossed to as it does now but be able to work with the data in column C you ll find on the excell sheet that I attach.
Thank you very much!!! in advance
Sincerely Dennis
Sub movetocolumns()Dim i As Integer, iRow As Integer
Dim arrSource As Variant
'Set the first row
iRow = 1
With ActiveWorkbook.Worksheets("Sheet1")
'get the data into an array from the first column
arrSource = Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
'parse every value of the array and add the data to the next column
For i = 1 To (UBound(arrSource) - UBound(arrSource) Mod 3) Step 3
.Cells(iRow, 2) = arrSource(i, 1)
.Cells(iRow, 3) = arrSource(i + 1, 1)
.Cells(iRow, 4) = arrSource(i + 2, 1)
iRow = iRow + 1
Next i
'add the remaining values
Select Case UBound(arrSource) Mod 3
Case 1 'one item to add
.Cells(iRow, 2) = arrSource(i, 1)
Case 2 'still two items to add
.Cells(iRow, 2) = arrSource(i, 1)
.Cells(iRow, 3) = arrSource(i + 1, 1)
Case Else 'nothing to add
End Select
End With
End Sub