Inserting lines based on IF

Neil A

New Member
Joined
Aug 13, 2008
Messages
12
Hi.

Slightly tricky problem to explain, but here goes:

I have an amount of data split into various fields. I need to do something similar to the following:

In each row I have three fields separated by columns: name, sector and specialty. There is only one name and one sector for each record, but possibly several specialties (of which there are fifteen types in total, so they do not appear in a consistent column. specialty 'i' could appear in columns 3, 4, 5 through to 17. ie, sample entries below:

sheet 1
a1 name a2 sector a3 specialty i a4 specialty iv
b2 name b2 sector b3 specialty ii b3 specialty iv b4 specialty x
c3 name c4 sector c5 specialty i c6 specialty ii

The thing is, for every specialty in a row, I need new records created, so the above would become:

sheet 2
a1 name a2 sector a3 specialty i
a1 name a2 sector a3 a4 specialty iv
b2 name b2 sector b3 specialty ii
b2 name b2 sector b3 specialty iv
b2 name b2 sector b4 specialty x
c3 name c4 sector c5 specialty i
c3 name c4 sector c6 specialty ii

I'm not sure if the above is actually possible, but even if it's to say it can't be done, all help gratefully received. You could be saving someone a lot of work.

Thanks,
Neil.
 

Some videos you may like

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
Try:

Code:
Sub Test()
    Dim Sh As Worksheet
    Dim Rng As Range
    Dim ShNew As Worksheet
    Dim r As Integer
    Dim c As Integer
    Dim x As Integer
    Set Sh = Worksheets("Sheet1")
    Set Rng = Sh.Range("A1").CurrentRegion
    Set ShNew = Worksheets.Add
    x = 1
    For r = 1 To Rng.Rows.Count
        For c = 3 To Rng.Columns.Count
            If Rng.Cells(r, c) <> "" Then
                ShNew.Cells(x, 1) = Rng.Cells(r, 1)
                ShNew.Cells(x, 2) = Rng.Cells(r, 2)
                ShNew.Cells(x, 3) = Rng.Cells(r, c)
                x = x + 1
            End If
        Next c
    Next r
End Sub
 

Neil A

New Member
Joined
Aug 13, 2008
Messages
12
Thanks, Andrew. That was swift. There's some stuff there I don't understand at all, but I'll give it a go with a test sheet and let you know how I get on.

Best wishes,
Neil.
 

mikerickson

MrExcel MVP
Joined
Jan 15, 2007
Messages
23,564
This should do what you want
Code:
Sub test()
Dim oneCell As Range
Set oneCell = ThisWorkbook.Sheets("sheet1").Range("A1")
Do Until oneCell = ""
    With oneCell
        If .Offset(0, 3) <> "" Then
            With .Offset(1, 0).EntireRow
                .Insert
                .Offset(-2, 0).Resize(2, .Columns.Count).FillDown
            End With
            .Offset(1, 2).Delete shift:=xlToLeft
        End If
    End With
    Set oneCell = oneCell.Offset(1, 0)
Loop
oneCell.Offset(0, 3).Resize(1, 15).EntireColumn.Delete

End Sub
 

al_b_cnu

Well-known Member
Joined
Jul 18, 2003
Messages
4,493
Hi Neil, Welcome to the board!

Try this macro:
Code:
Sub CopyData()
Dim iCol As Integer, icolEnd As Integer
Dim lRowEnd As Long, lRow As Long, lOutputRow As Long
Dim rCur As Range
Dim vOutputData() As Variant, vCurLine() As Variant
Dim WSFrom As Worksheet, wsTo As Worksheet

Set WSFrom = Sheets("Sheet1")
Set wsTo = Sheets("Sheet2")

lRowEnd = WSFrom.Cells(Rows.Count, "A").End(xlUp).Row
lOutputRow = 0
For Each rCur In WSFrom.Range("A1:A" & lRowEnd)
    icolEnd = WSFrom.Cells(rCur.Row, Columns.Count).End(xlToLeft).Column
    vCurLine = WSFrom.Range(Cells(rCur.Row, 1).Address, Cells(rCur.Row, icolEnd).Address).Value
    
    For iCol = 3 To icolEnd
        lOutputRow = lOutputRow + 1
        ReDim Preserve vOutputData(1 To 3, 1 To lOutputRow)
        vOutputData(1, lOutputRow) = vCurLine(1, 1)
        vOutputData(2, lOutputRow) = vCurLine(1, 2)
        vOutputData(3, lOutputRow) = vCurLine(1, iCol)
    Next iCol
Next rCur

wsTo.Cells.ClearContents
wsTo.Range("A1:C" & UBound(vOutputData, 2)).Value = WorksheetFunction.Transpose(vOutputData)
End Sub
to install, type [Alt-F11] and from the menu Insert > Module

Paste the above code into the code window.

To run the macro, [Alt-F8], select the macro 'CopyData' from the list and select 'Run'

[Edit] I see that I've been beaten to it by both andrew AND Mik :(
but mine is more efficient (debate ensues) :)
 

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
[Edit] I see that I've been beaten to it by both andrew AND Mik :(
but mine is more efficient (debate ensues) :)
Before deciding what's most efficient, let's wait until Jindon posts his version using the Scripting Dictionary. ;)
 

al_b_cnu

Well-known Member
Joined
Jul 18, 2003
Messages
4,493
Andrew,

no disrespect intended - After posting my code AND seeing I'd been beaten by you AND Mik, felt I had to justify myself, even if it was tongue in cheek :)
 

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
Andrew,

no disrespect intended - After posting my code AND seeing I'd been beaten by you AND Mik, felt I had to justify myself, even if it was tongue in cheek :)
No disrespect taken. I thought your comment was tongue in cheek, as was mine. :)
 

Neil A

New Member
Joined
Aug 13, 2008
Messages
12
Al, that seems to work perfectly at the moment. I'm just going to throw the proper data at it and see what happens.

Thanks so much to all three of you. Such a big help. If any of you work in an industry that would benefit from being included on chb.com (take a look at the site), let me know and I'll set up a free account for a year for you.

Best wishes,
Neil.
 

Neil A

New Member
Joined
Aug 13, 2008
Messages
12
Okay, to be a pain, I'm sure this is relatively simple but I've not used macros before.

I hadn't thought ahead this far, but my actual data contains 13 fields (a-m) as opposed to the 3 in the test version I described. Then the specialties kick in at column n. It would be great if you could show me the code for how to achieve this amendment. I'll then also be able to compare the two and maybe even learn something in the process.

Thanks again,
Neil.
 

Watch MrExcel Video

Forum statistics

Threads
1,099,624
Messages
5,469,771
Members
406,669
Latest member
Rubrob

This Week's Hot Topics

Top