Thanks a lot. Both of you.
Thanks a lot. Both of you.
Last edited by prkhan56; 06-14-2015 at 04:38 AM. Reason: Solved
Try the following code to see if this works for you....
![]()
Sub ReArrangeData() Dim lr As Long Application.ScreenUpdating = False Columns(1).Insert Rows(1).Insert lr = Cells(Rows.Count, 2).End(xlUp).Row For i = 2 To lr If Cells(i, 3) = "" Then Cells(i + 1, 1) = Cells(i, 2) Cells(i, 1).EntireRow.Delete Else Cells(i, 1) = Cells(i - 1, 1) End If Next i Cells(1, 1) = "STORE NAME" Cells(1, 2) = "REF NO" Cells(1, 3) = "DESCRIPTION" Cells(1, 4) = "STOCK" Cells(1, 5) = "RETAIL PRICE" Range("A1:E1").Font.Bold = True Columns.AutoFit Application.ScreenUpdating = True MsgBox "Done.", vbInformation End Sub
Regards
sktneer
Treat people the way you want to be treated. Talk to people the way you want to be talked to.
Respect is earned NOT given.
Hi,
An alternative (using array) :
![]()
Sub Store() Dim arrInput, arrLeft, currentStore, i As Long, j As Long, p As Long arrInput = Sheets("Input").Range("A1").CurrentRegion.Value ReDim arrLeft(1 To UBound(arrInput, 1), 1 To 1) p = 1 For i = 1 To UBound(arrInput, 1) If arrInput(i, 2) = "" Then currentStore = arrInput(i, 1) Else p = p + 1 arrLeft(p, 1) = currentStore For j = 1 To UBound(arrInput, 2) arrInput(p, j) = arrInput(i, j) Next j End If Next i With Sheets("Output") .Range("A1").Resize(UBound(arrLeft, 1)) = arrLeft .Range("B1").Resize(p, UBound(arrInput, 2)) = arrInput .Range("A1").Resize(1, 5) = Array("STORE NAME", "REF NO", "DESCRIPITON", "STOCK", "RETAIL PRICE") End With End Sub
Regards
1. I care dog
2. I am a loop maniac
3. Forum rules link : Click here
3.33. Don't forget to mark the thread as solved, this is important
Super, marvelous. Works great.
Both of you.
Thanks a lot.
You're welcome. Glad we could help.
There are currently 1 users browsing this thread. (0 members and 1 guests)
Bookmarks