Add new rows, defined by a cell

DANDERSON · May 14th 2005

A B C
B001 - B003 14 A
B004 6 A
B005 14 A
B006 4 A
B007 10 A
B008 - A
B009 ~ B012 8 A
B015 - A

For this example I have 3 colums of data.
in column A I have: B001 - B003
With this case, I want to create additional rows like this with same sharing data in column B & C:

needs to be:

B001 14 A
B002 14 A
B003 14 A

In this example:

column A I have: B009 ~ 1012

needs to be:

B009 8 A
B012 8 A

Notice the "-" means all numbers as in 1-3 = 1,2,3
Notice the "~" means all numbers as in 1~3 = 1,3

Hope this makes sense. I greatly appreciate it.

I am attaching the .csv file that gets generated. I renamed with .txt extension to upload.
Thank you again
Dan

**Batman** · May 14th 2005

Re: Add new rows, defined by a cell

Hi Dan,

Try running this program with your sheet active

Code

Sub AddNewRows()
    Dim lngRow As Long
    Dim intItem As Integer
    Dim lngOutRow As Long
    
    lngOutRow = 1
    lngRow = 1
    Do Until IsEmpty(Cells(lngRow, 1))
        If Len(Trim(Cells(lngRow, 1))) = 4 Then
            Range(Cells(lngOutRow, 6), Cells(lngOutRow, 8)) = Range(Cells(lngRow, 1), Cells(lngRow, 3)).Value
            lngOutRow = lngOutRow + 1
        Else
            If InStr(1, Cells(lngRow, 1), "~") > 0 Then
                Cells(lngOutRow, 6) = Left(Cells(lngRow, 1).Value, 4)
                Range(Cells(lngOutRow, 7), Cells(lngOutRow, 8)) = Range(Cells(lngRow, 2), Cells(lngRow, 3)).Value
                lngOutRow = lngOutRow + 1
                Cells(lngOutRow, 6) = Mid(Cells(lngRow, 1).Value, 8, 4)
                Range(Cells(lngOutRow, 7), Cells(lngOutRow, 8)) = Range(Cells(lngRow, 2), Cells(lngRow, 3)).Value
                lngOutRow = lngOutRow + 1
            Else
                For intItem = CInt(Mid(Cells(lngRow, 1), 2, 3)) To CInt(Mid(Cells(lngRow, 1), 9, 3))
                    Cells(lngOutRow, 6) = Left(Cells(lngRow, 1).Value, 1) & Right("000" & intItem, 3)
                    Range(Cells(lngOutRow, 7), Cells(lngOutRow, 8)) = Range(Cells(lngRow, 2), Cells(lngRow, 3)).Value
                    lngOutRow = lngOutRow + 1
                Next
            End If
        End If
        lngRow = lngRow + 1
    Loop
End Sub

Display More

Hope this helps.

Regards,
Batman.

DANDERSON · May 16th 2005

Re: Add new rows, defined by a cell

Helps immensely!! Thank very much. I learned a few things to.
The code was a perfect example, and I was able to extend the range for 3 additional columns of data I just added.
Thank you very much again. I have thousands of rows of data this will work on.

Take care,
Dan
:thanx:

Add new rows, defined by a cell

Participate now!

Share