converting pseudocode to VBA

**dougf** · 03-15-2009, 01:36 PM

I have a spreadsheet with 4 columns of information, then a column for a primary name, and then many columns of secondary names (with a different number of secondary names for each row).

For rows with more than 1 secondary name, I need to create a new row with a copy of all the columns up to the secondary name for each secondary name in the row.

A row in the spreadsheet looks like this:

data data data data PrimaryName SecondaryName1 SecondaryName2 SecondaryName3... SecondaryNameN

I need this row to be replaced by the following set of rows:

data data data data PrimaryName SecondaryName1

data data data data PrimaryName SecondaryName2

data data data data PrimaryName SecondaryName3
...
data data data data PrimaryName SecondaryNameN

Here is some possible pseudo code for the algorithm:

int curRow = 1
IF (Cell(FcurRow)!=null)
{
* insert a duplicate of curRow below curRow
* delete all columns after E for curRow
* for the duplicated curRow (which is now curRow+1), shift over columns F through Z and make these columns E through Y
}
curRow++;

**royUK** · 03-15-2009, 01:44 PM

To best describe or illustrate your problem you would be better off attaching a dummy workbook, the workbook should contain the same structure and some dummy data of the same type as the type you have in your real workbook - so, if a cell contains numbers & letters in this format abc-123 then that should be reflected in the dummy workbook.

If needed supply a before and after sheet in the workbook so the person helping you can see what you are trying to achieve.

Doing this will ensure you get the result you need!

**dougf** · 03-15-2009, 02:09 PM

Thank you.

Attached please find a copy of the sample data, and below what the sample data needs to look like.

**StephenR** · 03-15-2009, 04:49 PM

Try this. Results in sheet2.

Sub x()

Dim rng As Range, rng2 As Range, nCol As Long

Application.ScreenUpdating = False

Sheet1.Activate

For Each rng In Range("A1", Range("A1").End(xlDown))
    nCol = rng.End(xlToRight).Column - 4
    Set rng2 = rng.Resize(, 4)
    With Sheet2
        .Cells(Rows.Count, 1).End(xlUp)(2).Resize(nCol, 4).Value = rng2.Value
        rng.Offset(, 4).Resize(, nCol).Copy
            .Cells(Rows.Count, 5).End(xlUp)(2).Resize(nCol).PasteSpecial Transpose:=True
    End With
Next rng

Application.ScreenUpdating = True

End Sub