Help with 'Spilt' function, please

[kbishop94]

I've got this code all messed up and its not returning the correct parts of a string that I am attempting to spilt up.

Here is what I am starting with and what the original cells look like with the complete (un-spilt) data. There are 9 rows in my example. Ultimately there will be a varying number of rows so I need to make sure I have it look to see where the last row is.

And here is what I am trying to get to... (except its not correct. its doubling up on some of the individual strings, I cant see where in my code that is making it do this.)

Full disclosure, I found various parts on here and elsewhere when I googled what I need the code to do,and thats where I somehow got this all messed up.

my screwed up code:

Private Sub CommandButton2_Click()

    Dim LR As Long, i As Long
    Dim X As Variant
    Application.ScreenUpdating = False
    Dim iCell As Variant
    
    Dim rCol As Long
    rCol = ActiveSheet.UsedRange.Rows.Count
    For Each Cell In Range(Cells(1, rCol), Cells(1, rCol))
    Cell = Trim(Cell)

    LR = Range("A" & Rows.Count).End(xlUp).Row
    Columns("A").Insert
    MsgBox LR
    For i = LR To 1 Step -1
        With Range("B" & i)
            If InStr(.Value, " ") = 0 Then
                .Offset(, -1).Value = .Value
            Else
                X = Split(.Value, " ")
                .Offset(1).Resize(UBound(X)).EntireRow.Insert
                .Offset(, -1).Resize(UBound(X) - LBound(X) - 1).Value = Application.Transpose(X)
            End If
        End With
    Next i
    Columns("B").Delete

Next
   
    LR = Range("A" & Rows.Count).End(xlUp).Row
    With Range("A1:A" & LR)
        On Error Resume Next
        .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
    On Error GoTo 0
        .Value = .Value
    End With

    Application.ScreenUpdating = True

End Sub

I had to put the bottom part of that code in there because it was inserting a blank row after every one of the original cells that contained the original string before getting split up.

Thanks in advance for setting me straight here.

 

[DanteAmor]

Apparently your data inside the cell is separated by character 10.
Run the following macro, put your data on sheet1, the result will be in column A of sheet2.
Change in the macro sheet1 and sheet2 for the names of your sheets.

Sub SplitData()
  Dim a As Variant, b As Variant, i As Long, j As Long, v As Variant
  a = Sheets("Sheet1").Range("A1", Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a) * 100, 1 To 1)
  For i = 1 To UBound(a)
    For Each v In Split(a(i, 1), Chr(10))
      j = j + 1
      b(j, 1) = v
    Next
    j = j + 1
  Next
  Sheets("Sheet2").Range("A1").Resize(j).Value = b
End Sub

 

[kbishop94]

Apparently your data inside the cell is separated by character 10.
Run the following macro, put your data on sheet1, the result will be in column A of sheet2.
Change in the macro sheet1 and sheet2 for the names of your sheets.

Brilliant! That did the trick. ?
Thanks so much!

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.

 

[kbishop94]

I noticed that these annoying blank rows are back. Below is the code that I added in an effort to get rid of them. It didn't help. lol

Private Sub CommandButton2_Click()

Application.ScreenUpdating = False

  Dim a As Variant, b As Variant, i As Long, j As Long, v As Variant
  a = Sheets("Test1").Range("A1", Sheets("Test1").Range("A" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a) * 100, 1 To 1)
  For i = 1 To UBound(a)
    For Each v In Split(a(i, 1), Chr(10))
      j = j + 1
      b(j, 1) = v
    Next
    j = j + 1
  Next
  Sheets("Test2").Range("A1").Resize(j).Value = b

' LOCATE AND DELETE ANY BLANK ROWS;  NOT WORKING THOUGH. :(

ActiveWorkbook.Worksheets("Test2").Activate
Dim LR As Long
LR = Worksheets("Test2").UsedRange.Rows.Count
    
    With Range("A1:A" & LR)
        On Error Resume Next
        .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
    On Error GoTo 0
        .Value = .Value
    End With
    
    Application.ScreenUpdating = True

End Sub

And while I'm tackling the blank row issue, heres another one for ya

If you look at A1 (and each subsequent cell that is the start of the next 'original' cell before it was split) you can see that the "ALL" string is lumped together with one of the codes that I use... thats actually perfect (call it a happy accident I guess ?) because next I also was going to have the code search, find and delete certain cells that contained some of the codes that I dont need for this particular metric that I will be running (this was just my test bed in order to get the code singing along happily on a small scale.) Both the "ALL" string along with all other ones that just happen to be attached to it (like "CSR0o" in cell A1 and "SEA0o" in cell A8) I need to be rid off anyway.
So(hopefully) the code to locate blank rows can also search for any cell that has "ALL" in it (either entirely or part of it) and snuff out that little bugger too.

Thanks (again )

-Keith

 

[kbishop94]

PS- I checked to make sure that the blank rows are indeed BLANK, and it looks like they are. (I put the curosor on the cell, then went to the formula bar to make sure that there was no spaces or anything. I also highlighted one of the blank cells, right clicked, then "format cells" and then look in the sample box to make sure that there wasn't anything else in there.... there wasn't

 

[DanteAmor]

I did not understand.

You have this:
CSR0o ALL

And you want this:
CSR0o

Or Do you want to delete the entire row?

Note: To show examples of your data, you could use XL2BB tool. Look in my signature.

 

[kbishop94]

And while I am at it... I better tell you something that else, that... because when you said in your reply:

Apparently your data inside the cell is separated by character 10.

THose cells have been known to do some wonky stuff with this workbook... Here is how that particular column is populated with the data/string that it contains:

I have a userform where people will enter an "incident" (thats what this workbook is... a incident log) (for quality issues, not safety or EHS incidents) There are checkboxes where folks can 'tick' off certain boxes that describe or define the incident (plus it makes it great for using the data to show trends, potential risks, problem areas, etc...)

Here is the userform for when users go to enter a new incident (with a couple of the boxes 'ticked' for effect) Each of these checkboxes have one of the codes that I use to represent that particular problem.

And here is the code for how each box that is ticked gets its specific code added to the cell:

I used this same technique in another separate workbook and a couple years back it caused me some problems that i couldn't find where the issue was and when I finally did it was the way that it was added to the cells when utilizing the " & vbCrLf " and various text.

I only mention this here so that you can see where and how the data was originally entered into the original cell (I thought it might have something to do with that 'character 10' you mentioned.)

 

[kbishop94]

I did not understand.

You have this:
CSR0o ALL

And you want this:
CSR0o

Or Do you want to delete the entire row?

Note: To show examples of your data, you could use XL2BB tool. Look in my signature.

Thank you. I wasn't aware of the BB tool. Very cool. Thanks. (i just added it on my add-ons in excel. )
Yes, both of the codes that are in the column "ALL" and "CSR0o" I was going to implement further lines of code to find and delete those particular ones.
What I was saying (sorry... it was confusing, I see that now) was that since both "ALL" and "CSR0o" were still together instead of being separated, it was perfectly fine because both of those are unwanted for what I am ultimately trying to do anyway. The blank lines are the real issue. The next code that I have (and it works, so I shouldn't need any help with it... [fingers crossed] ) is the scripting dictionary where I will have it take a tally of how many times each unique code appears (less the "ALL" and "CSR0o" ones, that is.) That was really the end game of my little coding project here. Take all the codes from a specific range and tally how many times certain ones occur during the predefined date range. (hope that makes sense.) Thank you again for your help. Its very much appreciated.

 

[DanteAmor]

Try this

Sub SplitData()
  Dim a As Variant, b As Variant, i As Long, j As Long, v As Variant
  a = Sheets("Sheet1").Range("A1", Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a) * 100, 1 To 1)
  For i = 1 To UBound(a)
    For Each v In Split(a(i, 1), Chr(10))
      If InStr(1, Trim(v), "ALL", vbTextCompare) = 0 And Trim(v) <> "" Then
        j = j + 1
        b(j, 1) = Trim(v)
      End If
    Next
    j = j + 1
  Next
  Sheets("Sheet2").Range("A1").Resize(j).Value = b
End Sub