Indexing in Excel

[Kumaras]

Hi,
I have a index#1 as below,and would like it to look like index#2...Is
there any function,formulae or code ....Appreciate your help...

Index#1
ITEM TAG NO. DWG. NO.
1 11HS051A, 11XA054A 00A1CD001W51
2 11HS051B, 11XA054B 00A1CD002W52
3 11HS601A, 11XA603A 00A1CD003W53

Index#2
ITEM TAG NO. DWG. NO.
1 11HS051A 00A1CD001W51
2 11XA054A 00A1CD001W51
3 11HS051B 00A1CD001W52
4 11XA054B 00A1CD002W52
5 11HS601A 00A1CD001W53
6 11XA603A 00A1CD003W53

Thanks in advance
A.kumar

 

[Gary Keramidas]

you can try something this

Sub test()
Dim lastrow As Long
Dim arr As Variant
Dim ws As Worksheet
Dim i As Long, j As Long
Set ws = Worksheets("Sheet1")
lastrow = ws.Cells(Rows.Count, "A").End(xlUp).Row
i = 1
With ws
For j = 2 To lastrow + 1 Step 2
.Range("A" & j).EntireRow.Insert
Next
lastrow = ws.Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To lastrow Step 2
arr = Split(Range("b" & i), ",")
.Range("B" & i) = arr(0)
.Range("B" & i + 1) = Trim(arr(1))
.Range("c" & i + 1) = Range("c" & i).Value
Next
End With
End Sub

 

[Bob Phillips]

This will allow for 2 or more (variable) entries on a line

Sub Test()
Dim iLastRow As Long
Dim nEntries As Long
Dim iPos As Long
Dim i As Long, j As Long

iLastRow = Cells(Rows.Count, "B").End(xlUp).Row
For i = iLastRow To 2 Step -1
nEntries = Len(Cells(i, "B").Value) - _
Len(Replace(Cells(i, "B").Value, ",", ""))
If nEntries > 0 Then
Rows(i + 1).Resize(nEntries).Insert
For j = nEntries To 1 Step -1
iPos = InStrRev(Cells(i, "B").Value, ",")
Cells(i + j, "B").Value = Right(Cells(i, "B").Value, _
Len(Cells(i, "B").Value) - iPos)
Cells(i + j, "C").Value = Cells(i, "C").Value
Cells(i, "B").Value = Left(Cells(i, "B").Value, iPos - 1)
Next j
End If
Next i

iLastRow = Cells(Rows.Count, "B").End(xlUp).Row
Range("A3") = 2
Range("A2:A3").AutoFill Range("A2").Resize(iLastRow - 1)

End Sub



--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

 

[Kumaras]

Very thanks for the help....Bob it worked fine.....Fantastic
But I made a small error the Index should have looked this way as below
the iten is basically page number ...Can you do that for me..

ITEM TAG NO. DWG. NO.
1 11HS051A, 11XA054A 00A1CD001W51
2 11HS051B, 11XA054B 00A1CD002W52
3 11HS601A, 11XA603A 00A1CD003W53

Index#2
ITEM TAG NO. DWG. NO.
1 11HS051A 00A1CD001W51
1 11XA054A 00A1CD001W51
2 11HS051B 00A1CD001W52
2 11XA054B 00A1CD002W52
3 11HS601A 00A1CD001W53
3 11XA603A 00A1CD003W53
Thanks

A.Kumar

 

[Kumaras]

Thanks Gary for the help....It didn't work however,It gives a message
"subscript out of range"
But I made a small error in the Index#2 should have looked this way as
below
the item is basically page number ...Can you do that for me..

Index#1
ITEM TAG NO. DWG. NO.
1 11HS051A, 11XA054A 00A1CD001W51
2 11HS051B, 11XA054B 00A1CD002W52
3 11HS601A, 11XA603A 00A1CD003W53


Index#2
ITEM TAG NO. DWG. NO.
1 11HS051A 00A1CD001W51
1 11XA054A 00A1CD001W51
2 11HS051B 00A1CD001W52
2 11XA054B 00A1CD002W52
3 11HS601A 00A1CD001W53
3 11XA603A 00A1CD003W53

 

[Bob Phillips]

That is actually simpler <g>

Sub Test()
Dim iLastRow As Long
Dim nEntries As Long
Dim iPos As Long
Dim i As Long, j As Long

iLastRow = Cells(Rows.Count, "B").End(xlUp).Row
For i = iLastRow To 2 Step -1
nEntries = Len(Cells(i, "B").Value) - _
Len(Replace(Cells(i, "B").Value, ",", ""))
If nEntries > 0 Then
Rows(i + 1).Resize(nEntries).Insert
For j = nEntries To 1 Step -1
Cells(i + j, "A").Value = Cells(i, "A").Value
iPos = InStrRev(Cells(i, "B").Value, ",")
Cells(i + j, "B").Value = Right(Cells(i, "B").Value, _
Len(Cells(i, "B").Value) - iPos)
Cells(i + j, "C").Value = Cells(i, "C").Value
Cells(i, "B").Value = Left(Cells(i, "B").Value, iPos - 1)
Next j
End If
Next i

End Sub

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

 

[Kumaras]

Hi Bob,
Great....worked fine....Thanks for your effort....

A.kumar

 

[Gary Keramidas]

don't know why it didn't work for you. i had your data in columns B and C. it
worked with your 3 examples, maybe i missed something.