Text to rows VBA

[Stildawn]

Hi All

I need a VBA code to basically take a cell of text and convert to rows (not columns as there are thousands of data points).

The cell looks like this:

E12, E55, E658, E554, E9898, E6565, E4542 etc (but thousands of Exyz, )

So the VBA code would simple cut this cell by rows like so:

E12
E55
E658
E9898
E6565
etc

Any help would be greatly appreciated.

Thanks

 

[Cindy Ellis]

Excel 2007 and later supports 16,384 columns, so if the count is less than that, the easiest way would be to do text-to-columns, delimited, then both comma AND space as delimiters, with "treat consecutive delimiters as one" also selected.
You can then highlight the whole row and use copy-paste special-transpose to convert the data from a row to a column.
Hope that helps...if not, please post back and I'll work out the details of a macro to convert directly to rows.

 

[Stildawn]

I think my version is only 265 columns? So VBA is the only way I believe.

 

[Cindy Ellis]

OK...here is some code, but you will probably need to modify it a bit if column B already has data:

Sub cell2rows()'
' Splits contents of current cell, then pushes the output to a column
'


    Dim MyCell As String, i As Long
    Dim DataArray As Variant
    MyCell = ActiveCell.Value
    DataArray = Split(MyCell, ",", -1)
    For i = 1 To UBound(DataArray)
        'Change "B" in the following statement as needed.  If you have headers in the first column, change " & i" to " & i + 1"
        Range("B" & i).Value = DataArray(i)
    Next i
End Sub

Hope that helps,

 

[Rick Rothstein]

Hi All

I need a VBA code to basically take a cell of text and convert to rows (not columns as there are thousands of data points).

The cell looks like this:

E12, E55, E658, E554, E9898, E6565, E4542 etc (but thousands of Exyz, )

So the VBA code would simple cut this cell by rows like so:

E12
E55
E658
E9898
E6565
etc

Any help would be greatly appreciated.

I am assuming that the delimiter between your E numbers is a comma followed by a space as shown in your message. Given that, select the cell with you E numbers and then run this macro...

Sub SplitEnumbersDown()
  Dim Enumbers() As String
  Enumbers = Split(Selection.Value, ", ")
  Selection(1).Resize(UBound(Enumbers) + 1) = Application.Transpose(Enumbers)
End Sub

 

[Stildawn]

OK...here is some code, but you will probably need to modify it a bit if column B already has data:

Sub cell2rows()'
' Splits contents of current cell, then pushes the output to a column
'


    Dim MyCell As String, i As Long
    Dim DataArray As Variant
    MyCell = ActiveCell.Value
    DataArray = Split(MyCell, ",", -1)
    For i = 1 To UBound(DataArray)
        'Change "B" in the following statement as needed.  If you have headers in the first column, change " & i" to " & i + 1"
        Range("B" & i).Value = DataArray(i)
    Next i
End Sub

Hope that helps,

I am assuming that the delimiter between your E numbers is a comma followed by a space as shown in your message. Given that, select the cell with you E numbers and then run this macro...

Sub SplitEnumbersDown()
  Dim Enumbers() As String
  Enumbers = Split(Selection.Value, ", ")
  Selection(1).Resize(UBound(Enumbers) + 1) = Application.Transpose(Enumbers)
End Sub

Thanks guys, both worked, might go with the second one as it looks simplier. Thanks heaps saved me lots of time.

Cheers

 

[Stildawn]

Hi Again

Carrying on from the above, this is my full code so far:

Sub generateerrortable()
'Sets the file path of the other workbook for later use
Dim file As Range
Set file = Range("Scorecard!rgFileToBeChecked")

'Makes the new sheet in the active workbook
Worksheets.Add.Name = "Error Table"
Sheets("Error Table").Select
ActiveSheet.Move after:=Worksheets(Worksheets.Count)

'Moves to the right sheet to start
Worksheets("Validation").Select

'Looks for cells of data (the Exyz data of my question above) and then copies the cells with data to new sheet
'pasting them in new columns with two empty columns in between each one
For Each cell In Range("P8:P39")
    If cell.Value = "" Then
    Else
    Dim NextCol As Long
        If Sheets("Error Table").Range("A1").Value = "" Then
            NextCol = 1
        Else
            NextCol = Sheets("Error Table").Cells(1, Columns.Count).End(xlToLeft).Column + 3
        End If
    cell.Select
    Selection.Copy Sheets("Error Table").Cells(1, NextCol)
    End If
Next cell

'Moves to next sheet
Worksheets("Error Table").Select

'This is the code from you guys above, turns the massive cell data into rows
For Each cell In Range("A1:DM1")
    If cell.Value = "" Then
    Else
        cell.Select
        Dim Enumbers() As String
        Enumbers = Split(Selection.Value, ",")
        Selection(1).Resize(UBound(Enumbers) + 1) = Application.Transpose(Enumbers)
    End If
Next cell

'This is the next part I'm having issues with
For Each cell In Range("A1:DM1")
    If cell.Value = "" Then
    Else
        With cell.Offset(0, 1)

'NOT FINISHED

End Sub

So this goes through the data as I've indicated in the code, my next question is, is it possible to run a "For Each cell" command within an "For Each cell" command???

Basically the part I'm having issue with so far checks along row 1 for cells with data, it then starts to work with the empty column next to a column that is populated (the " With cell.Offset(0,1)" bit).

In this With block, I need to basically run this code:

Sub test()
Dim ccol As String
ccol = InputBox("Enter column to count") 'This will be the column letter of the column the above code finds data in (which is a list of E's etc)

Dim icol As String
icol = InputBox("Enter column to populate") 'This will be the column letter of the column next to the column its counting (so next to the list of E's)

Dim sh As String
sh = InputBox("Enter name of sheet to search") 'This is the sheet name to search in the other file, this is found by INDIRECT("RC[-14]",0) on the original cell that the E's are copied from

    Lastrow1 = Range(ccol & Rows.Count).End(xlUp).Row
        
    For Each cell In Range(icol & "1:" & icol & Lastrow1)
        cell.Value = "=[" & file & "]" & sh & "!" & cell.Offset(0, -1).Value
    Next cell

End Sub

This is the code I quickly made when I was doing this more manually. Basically I need to replace all the input boxs with references within the code I have so far and run the "For Each cell" command down the list of Exyz etc. (Theres more than one list of E's, there are J's, A's etc).

All it is, is putting the value of the Exyz cell from another sheet next to the Exyz list generated in this sheet, because the Exyz cell in the other sheet has an error, this "Error Table" just lists all the errors of the "file" sheet (Dim in first code).

Hope this makes sense lol its complicated I know.

Thanks

 

[Stildawn]

Update

I amended the code so that now, when it copies the original data from the Validation sheet, it also copies the sheet name required for later, puts the sheet name in row 1 and then the data transposes from row 2 down beneath the correct sheet name.

With that, I wrote this code which I think might work:

'This is the next part I'm having issues with
For Each Column In Range("A:DM")
    If Column.Value = "" Then
    Else
        lastrow1 = Range(Column & Rows.Count).End(xlUp).Row
        For Each cell In Range(Column.Offset(0, 1) & "2:" & Column.Offset(0, 1) & lastrow1) 'So I'm hoping this range would be "Range(B2:B2000) for example if there was a list of data in column A.
            Dim sh As String
            sh = Range(Column & "1") 'And that sh would equal Range("A1") for example
            cell.Value = "=[" & file & "]" & sh & "!" & cell.Offset(0, -1).Value
        Next cell
    End If
Next Column

However I am getting a 1004 error on "lastrow1 = Range(Column & Rows.Count).End(xlUp).Row"

Any ideas?

Thanks