How to make the data row-wise?

[feipezi]

Hello guys,

I have some header copied from a PDF specs, to Excel. I was trying to make it row-wise because of the deformation of the header. The macro that I set up worked half way, which means it gave me what I wanted but Excel kept searching along the column and had gone too far and then ended up an error: 1004.

Here is the data (after the process); var in Col A; code in Col B. Code 'x' serves as an indicator that shows the first word of the header.

If the data is not clear enough, please see the attached, which has both the data (the real data has over 200 rows, this is just a sample) and the macro.

Thanks in advance.


var code
Study

​

x

​

Identifier
Identifier
Transmittal

​

x

​

Number
Number
Unique

​

x

​

Subject

​

Identifier
Subject
Identifier


Sub test()
Cells(1, 2).Activate
Do Until ActiveCell.Row >= 10
i = 1
While ActiveCell = ""
ActiveCell.Offset(-i, i + 1) = ActiveCell.Offset(, -1)
i = i + 1
ActiveCell.Offset(1).Activate
Wend
If ActiveCell.Row > 10 Then
Exit Sub
Else
ActiveCell.Offset(1).Activate
End If
MsgBox ActiveCell.Row
Loop
End Sub

 

[feipezi]

Sub FixHeader()
'add a x at the end of col where activecell is, a makeshift
Cells(1, 2).Activate
Do Until ActiveCell.Row > ActiveSheet.UsedRange.Rows.Count
i = 1
While ActiveCell = ""
ActiveCell.Offset(-i, i + 1) = ActiveCell.Offset(, -1)
i = i + 1
ActiveCell.Offset(1).Activate
Wend
If ActiveCell.Offset(, -1) = "" Then
Exit Sub
Else
ActiveCell.Offset(1).Activate
End If
Loop
End Sub

Sub DeleteBlankRows()
ActiveSheet.Range("b1:b3000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub



I added a "x" at the end of the Col B, making sure Col A on the same row is blank. It will work but it's not satisfactory. Any suggestion on improvement is welcome!
Like what I said, this is only a makeshift, certainly not a perfect solution. But at least, no error message shows up.

Thanks.

 

[zelgar]

I didn't have a problem with your original code except it wouldn't get the info for the last item with the code being x, but you might try the following :

Sub test2()
Dim col As Integer, code_row As Integer, var_row As Integer
var_row = 2
code_row = 2
col = 4
Do Until IsEmpty(Cells(var_row, 1))
    If IsEmpty(Cells(var_row, 2)) Then
        Cells(code_row, col) = Cells(var_row, 1)
        col = col + 1
    Else
        code_row = var_row
        col = 4
    End If
    var_row = var_row + 1
Loop
End Sub

 

[feipezi]

Hey, your code works too and no need to put a 'x' at the end of the data.

Thanks