Code help required

[Rohith1324]

Hi,

I have one spreadsheet with multiple lines ( in thousands )

In total I have 10 columns( headers ) and many rows. Each row will be unique.

In one of the column user have an option to enter multiple values, so they update it like 5555565657/5786543789/5654321678

Sometime they have used the separator "/", "&", ","...

My requirement is for the value after each separator should have one seperate line with same row line details for the 3 lines except this cell value... For example in the above example I have 3 values so by running macro excel should split that into 3 lines.

5555565657
5786543789
5654321678

Regards,
Rohith

 

[JLGWhiz]

In one of the column

I am a lousy guesser. You will just have to tell us which column

 

[Rohith1324]

I am a lousy guesser. You will just have to tell us which column

5th column

 

[Akuini]

5th column

Try this:

Sub a1125791a()
Dim x As String
Application.ScreenUpdating = False
    For Each x In Array("/", "&", ",") 'change to suit
    Range("E:E").Replace What:=x, Replacement:=vbLf, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Next
Application.ScreenUpdating = True
End Sub

 

[JLGWhiz]

This should work for whatever they use as delimiters except perhaps commas. Excel sees some numeric strings with commas as a single number without the commas.

Sub t()
Dim col As Long, c As Range, i As Long, spl As Variant
col = 5
With ActiveSheet
    For Each c In Intersect(.UsedRange, .Cells(2, col).Resize(.UsedRange.Rows.Count - 1))
        For i = 1 To Len(c.Value)
            If Not IsNumeric(Mid(c.Value, i, 1)) Then
                c.Replace Mid(c.Value, i, 1), " "
            End If
        Next
        spl = Split(c, " ")
        c.EntireRow.Copy
        If UBound(spl) > 0 Then
            c.Offset(1).Resize(UBound(spl)).EntireRow.Insert
        End If
        Application.CutCopyMode = False
        c.Resize(UBound(spl) + 1) = Application.Transpose(spl)
     Next
End With
End Sub

 

[Rohith1324]

This should work for whatever they use as delimiters except perhaps commas. Excel sees some numeric strings with commas as a single number without the commas.

Sub t()
Dim col As Long, c As Range, i As Long, spl As Variant
col = 5
With ActiveSheet
    For Each c In Intersect(.UsedRange, .Cells(2, col).Resize(.UsedRange.Rows.Count - 1))
        For i = 1 To Len(c.Value)
            If Not IsNumeric(Mid(c.Value, i, 1)) Then
                c.Replace Mid(c.Value, i, 1), " "
            End If
        Next
        spl = Split(c, " ")
        c.EntireRow.Copy
        If UBound(spl) > 0 Then
            c.Offset(1).Resize(UBound(spl)).EntireRow.Insert
        End If
        Application.CutCopyMode = False
        c.Resize(UBound(spl) + 1) = Application.Transpose(spl)
     Next
End With
End Sub

It's working when there are no blank cell in between...if there are any blank cells in between...it is throwing runtime error 13 type mismatch

 

[Akuini]

@Rohith1324
Did you try my code in post #4?

 

[Rohith1324]

@Rohith1324
Did you try my code in post #4?

Hi Akuini, when trying your code...im getting compile error - for each control variable must be variant or object and for each X getting highlighted.

 

[Rohith1324]

Hi Akuini, when trying your code...im getting compile error - for each control variable must be variant or object and for each X getting highlighted.

Even after changing it to variant just it is removing special characters from my data and nothing else

@Rohith1324
Did you try my code in post #4?

 

[Akuini]

Hi Akuini, when trying your code...im getting compile error - for each control variable must be variant or object and for each X getting highlighted.

Sorry, my mistake. X should be variant not string.

Sub a1125791a()
Dim x
Application.ScreenUpdating = False
    For Each x In Array("/", "&", ",") 'change to suit
    Range("E:E").Replace What:=x, Replacement:=vbLf, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Next
Application.ScreenUpdating = True
End Sub