Need a macro to duplicate rows conditionally

[Gamermatt]

Hello,

I have a large database. In columns A, B, C, and D there may be text. Every row has text in column A, and only some have text in B-D. I need a macro to duplicate the rows that have text in B, C, and/or D, copying those cells down to the appropriate cell. here is a basic example

before:

Excel Workbook
	A	B	C	D
1	product1	text1	text1	text3
2	product2	txt1	*	*
Sheet1

after:

Excel Workbook
	A	B	C	D
4	product1	text1	*	*
5	product1	text2	*	*
6	product1	text3	*	*
7	product2	txt1	*	*
Sheet1

The actual database has content in dozens of cells for each row, so make sure it copies the entire row.

Thanks
Matt

 

[capparfrank]

Sub repeater()
    Application.ScreenUpdating = False
 
    Dim val As Variant
 
 
    'find the last row
    Dim rowcount As Integer
    rowcount = 1
    While Cells(rowcount, 1).Value <> ""
        rowcount = rowcount + 1
    Wend
    rowcount = rowcount - 1
 
 
    'Iterate through all the rows, bottom to top so we don't process the rows that we insert
    For rowItr = rowcount To 1 Step -1
 
        'Iterate through the cells of each row that would cause us to copy a row.
        For colItr = 4 To 3 Step -1
 
            If Cells(rowItr, colItr).Value <> "" Then
                'copy the row, and insert it below
                Rows(rowItr).Copy
                Rows(rowItr + 1).Insert Shift:=xlDown
 
                'clean up the cells
                val = Cells(rowItr, colItr).Value
                Cells(rowItr, colItr).Value = ""
                Range(Cells(rowItr + 1, 2), Cells(rowItr + 1, 4)).Clear
                Cells(rowItr + 1, 2).Value = val
 
            End If
 
        Next colItr
 
    Next rowItr
 
    Application.ScreenUpdating = True
End Sub

 

[Gamermatt]

Thanks so much!