Inserting lines based on IF

[Neil A]

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.

 

[Andrew Poulsom]

Try:

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]

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]

This should do what you want

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]

Hi Neil, Welcome to the board!

Try this macro:

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]

[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]

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]

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]

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]

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.