Inserting a new row and copy the data.

[Ashrafe07]

I am having the data mention below, which I need that find a specific character it should copy the content into next cell, Any help using array code is more helpI am having the data mention below, which I need that find a specific character it should copy the content into next cell, Any help using array code is more helpfull. The Special Character here is (*).
Input
Column1 Column2


Adam
1212*14579*44556


John
3251


Stephen
12559*47895


Richard
8879*45487*464647*454647


Monty
8787*1114*1115*1116*117*118


Mark
5456




Output
Column1 Column2


Adam
1212




14579




44556


John
3251


Stephen
12559




47895


Richard
88799




45487




464647




454647


Monty
8879




1114




1115




1116




117




118


Mark
5456

[apo]

Hi..

Probably your Thread title ("Inserting a new row and copy the data") is not too accurate when you're actually wanting an array based solution?

Try..


Private Sub CommandButton1_Click()
Dim x, y, cnt As Long, k As Long, s As Long, j As Long, i As Long, ii As Long
With Range("A1").CurrentRegion
x = .Offset(1).Resize(.Rows.Count - 1).Value
cnt = 1: k = 1: s = 1
ReDim y(1 To UBound(Split(Replace(Join(Application.Transpose(.Columns(2).Offset(1).Resiz e(.Rows.Count - 1).Value), vbLf), vbLf, "*"), "*")) + 1, 1 To 2)
For i = 1 To UBound(y)
For j = 0 To UBound(Split(x(cnt, 2), "*"))
For ii = 1 To UBound(x, 2)
If ii = 2 Then
y(k, ii) = Trim(Split(x(cnt, 2), "*")(j))
Else
y(k, ii) = Trim(x(cnt, ii))
End If
Next ii
If s = UBound(Split(x(cnt, 2), "*")) + 1 Then
k = k + 1: cnt = cnt + 1: Exit For
Else
k = k + 1: s = s + 1
End If
Next j
s = 1
If k > UBound(y) Then
With Sheets("Sheet2")
.Range("A2").Resize(UBound(y), 2).Value = y
.Columns.AutoFit
.Select
End With
Exit Sub
End If
Next i
End With
End Sub