LinkBack URL
About LinkBacks
To make the querry more simple I have attached the sheet
A request to kindly access the sheet.
Thanks
GKT
To make the querry more simple I have attached the sheet
A request to kindly access the sheet.
Thanks
GKT
Try following code (create a button in jour sheet1 and assign this macro):
Sub test() Dim i As Long, j As Long, current As Long, cell As Range, prefix As String Application.ScreenUpdating = False For Each cell In Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row) current = Val(IIf(InStr(cell, "-"), Right(cell, Len(cell) - InStrRev(cell, "-")), cell)) prefix = Replace(cell, current, "") Sheets("Sheet2").Cells(j + 1, 2) = cell.Offset(0, 1) For i = 0 To cell.Offset(0, 1) j = j + 1 Sheets("Sheet2").Cells(j, 1) = IIf(Len(prefix), prefix & current, current) current = current + 1 Next i Next cell End Sub
Best Regards,
Kaper
Try the attached.
Thanks for the reply Kaper & Jindon.
The code is perfect but as I wanted it to be executed in the
same sheet i.e sheet1. Is it possible?
Else it is perfect.
Also Jindon I wanted the result in column A only.
Thanks again
GKT
Even simpler.
Also mine corrected:
Slower one, but could be (who knowsSub test() Dim i As Long, j As Long, k As Long, current As Long, cell As Range, prefix As String Application.ScreenUpdating = False For k = Cells(Rows.Count, "A").End(xlUp).Row To 1 Step -1 Set cell = Cells(k, 1) current = Val(IIf(InStr(cell, "-"), Right(cell, Len(cell) - InStrRev(cell, "-")), cell)) prefix = Replace(cell, current, "") j = Val(cell.Offset(0, 1)) If j > 0 Then cell.Offset(1, 0).Resize(j, 1).EntireRow.Insert For i = 1 To j current = current + 1 Cells(k + j, 1) = IIf(Len(prefix), prefix & current, current) Next i End If Next k End Sub) a bit easier to understand
Hello again Jindon
I just re-checked the first code. It is displaying the data in column A.
Comparing both of your code the I would prefer the first since the data
is put up in column A . I will manage the data in sheet2.
In that case even the Kaper solution is workable.
Only one change if I might require in the future. The data which is
put up in sheet2 as per the first code. I want the data from A2 onwards considering
row 1 will be headers.
Thanks
GKT
row 1 with headers:
For k = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
Change to
You can still see col.B, if you change toSub test() Dim a, b, i As Long, ii As Long, n As Long, x With Sheets("sheet1").Cells(1).CurrentRegion a = .Value ReDim b(1 To UBound(a, 1) * (Application.Sum(.Columns(2)) + UBound(a, 1)), 1 To 2) End With For i = 1 To UBound(a, 1) n = n + 1: b(n, 1) = a(i, 1): b(n, 2) = a(i, 2) x = mySplit(a(i, 1)) For ii = 1 To a(i, 2) n = n + 1: b(n, 1) = x(0) & x(1) + ii Next Next With Sheets("sheet2").Cells(2, 1).Resize(n) .CurrentRegion.Offset(1).ClearContents .Value = b .Parent.Activate End With End Sub Function mySplit(ByVal txt As String) With CreateObject("VBScript.RegExp") .Pattern = "^(\D*)(\d+)$" mySplit = Split(.Replace(txt, "$1;;$2"), ";;") End With End Function
With Sheets("sheet2").Cells(2, 1).Resize(n,2)
This is a confusing decision since both the options are acceptable to me
and can be given SOLVED.
But since Kaper gave the exact requirement I would grade him first and then to Jindon.
Also I will use both the codes as and when required.
However many thanks to both of them.
GKT
Don't worry.
Your question and the presentation of the result is confusing.
My result at the first time is exactly the same as your presentation anyway.
There are currently 1 users browsing this thread. (0 members and 1 guests)
Posting Permissions
Register To Reply
Bookmarks