Excel 2010 Create New Rows
I have an Excel spreadsheet that I want to create new rows and copy based on weather or not the column 'CEMLI ID' has multiple values. In other words if for example the CEMLI ID field has three values (E-201, E-195, E-304) then I want to create new rows for each value base on the multi value column CEMLI ID..
Issue ID L3 Process CEMLI ID
144 GL_02.10 Execute E-201, E-195, E-304......Initial row
Issue ID L3 Process CEMLI ID
144 GL_02.10 Execute E-201.... Result
144 GL_02.10 Execute E-195.... Result
144 GL_02.10 Execute E-304 ... Result
I have attached a sample spreadsheet
Sample.xlsx
Issue ID L3 Process CEMLI ID
144 GL_02.10 Execute E-201, E-195, E-304......Initial row
Issue ID L3 Process CEMLI ID
144 GL_02.10 Execute E-201.... Result
144 GL_02.10 Execute E-195.... Result
144 GL_02.10 Execute E-304 ... Result
I have attached a sample spreadsheet
Sample.xlsx
ASKER
I get a runtime error 5 Invalid Procedure call or argument. on line tws.Range("A" & Rows.Count).End(xlUp).Offs
ASKER
What do you mean by It fails where the sequence in column 3 is different from the sequence in column 4
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
So if the sequence is different can you ignore
Add
on error resume next
before that line and
on error goto 0
after that line
on error resume next
before that line and
on error goto 0
after that line
It fails where the sequence in column 3 is different from the sequence in column 4
Sub insertrowspercemliid()
Dim sws As Worksheet
Dim tws As Worksheet
Dim shname As String
Dim cel As Range
Dim itmlst() As String
Dim strt As String
Dim fins As String
Dim i As Long
Set sws = ActiveSheet
shname = sws.Name
Set tws = ThisWorkbook.Worksheets.Ad
For Each cel In sws.Range("A:A")
If cel <> "" Then
itmlst = Split(cel.Offset(, 2), ",")
If UBound(itmlst) = 0 Then
cel.Resize(, 18).Copy tws.Range("A" & Rows.Count).End(xlUp).Offs
Else
For i = 0 To UBound(itmlst)
cel.Resize(, 18).Copy tws.Range("A" & Rows.Count).End(xlUp).Offs
tws.Range("A" & Rows.Count).End(xlUp).Offs
strt = InStr(cel.Offset(, 3), itmlst(i))
If strt = 0 Then
strt = 1
fins = Len(cel.Offset(, 3)) - strt + 1
Else
If i = UBound(itmlst) Then
fins = Len(cel.Offset(, 3)) - strt + 1
Else
fins = InStr(cel.Offset(, 3), itmlst(i + 1)) - strt
If fins = -1 Then fins = Len(cel.Offset(, 3)) - strt + 1
End If
End If
tws.Range("A" & Rows.Count).End(xlUp).Offs
Next i
End If
End If
Next cel
End Sub