none
Automatically Expand Rows???

    Question

  • I have a huge .xlsx file (I've asked other questions about it before here as at 750,000 rows it's enormous)! What I need to do to parts of it is expand each Column A cell to match Column B cells. It's going to be easier if I show you. My current .xlsx is as follows:

    Ford              convertible

    Chevy           sedan

    Dodge           coupe

    Cadillac         sportscar

    What I need to end up with is:

    Ford              convertible

    Ford              sedan

    Ford              coupe

    Ford             sportscar

    Chevy          convertible

    Chevy           sedan

    Chevy           coupe

    Chevy         sportscar

    Dodge          convertible

    Dodge           sedan

    Dodge           coupe

    Dodge         sportscar

    Cadillac       convertible

    Cadillac        sedan

    Cadillac        coupe

    Cadillac       sportscar

    Of course this is a much simplified example as there are many of these groups, and each one has a different number of Column A and Column B cells, but at least they're all just two columns. No Column Cs. Therefore, I can't possibly do them manually, I need some formula that automatically expands them as above.

    Thanks in advance!

    Wednesday, August 04, 2010 10:36 PM

Answers

  • Try something like:

     

     

    Sub JCChimi()
    Dim ws1 As Worksheet, ws2 As Worksheet, N As Long, K As Long
    Dim t1 As String, t2 As String, L As Long, I As Long
    Set ws1 = Sheets("Sheet1")
    Set ws2 = Sheets("Sheet2")
    ws1.Activate
    N = Cells(Rows.Count, "A").End(xlUp).Row
    K = 1
    For I = 1 To N
        t1 = Cells(I, 1).Value
            For L = 1 To N
            ws2.Cells(K, 1).Value = t1
            ws2.Cells(K, 2).Value = Cells(L, 2).Value
            K = K + 1
        Next
    Next
    End Sub

    The code uses Sheet1 and Sheet2. Modify for your case.

     

    Thursday, August 05, 2010 12:01 PM

All replies

  • Try something like:

     

     

    Sub JCChimi()
    Dim ws1 As Worksheet, ws2 As Worksheet, N As Long, K As Long
    Dim t1 As String, t2 As String, L As Long, I As Long
    Set ws1 = Sheets("Sheet1")
    Set ws2 = Sheets("Sheet2")
    ws1.Activate
    N = Cells(Rows.Count, "A").End(xlUp).Row
    K = 1
    For I = 1 To N
        t1 = Cells(I, 1).Value
            For L = 1 To N
            ws2.Cells(K, 1).Value = t1
            ws2.Cells(K, 2).Value = Cells(L, 2).Value
            K = K + 1
        Next
    Next
    End Sub

    The code uses Sheet1 and Sheet2. Modify for your case.

     

    Thursday, August 05, 2010 12:01 PM
  • Thanks so much! I'll try it out and let you know. I really appreciate your help! :)
    Friday, August 06, 2010 1:03 PM
  • It worked the charm! Thanks so much!

     

     

    Now I have another somewhat related question. I'm still wrestling with the same 750,000 row spreadsheet and this question is for an other part of it! It's very similar to the example above except that now we have numbers which indicate the rows that have to be duplicated. Anyway, here is an example of what I now have:

     

    Mammals

    cat               3

    dog             2

    mouse       2

    deer            1

     

    Birds

    eagle          4

    hawk           2

    robin           1

    crow            1

     

    Fish

    cod               3

    tuna              2

    shark           2

    trout              1

     

    What I need to end up with is:

     

    Mammals/cat

    Mammals/cat-2

    Mammals/cat-3

    Mammals/dog

    Mammals/dog-2

    Mammals/mouse

    Mammals/mouse-2

    Mammals/deer

     

    Birds/eagle

    Birds/eagle-2

    Birds/eagle-3

    Birds/eagle-4

    Birds/hawk

    Birds/hawk-2

    Birds/robin

    Birds/crow

     

    Fish/cod

    Fish/cod-2

    Fish/cod-3

    Fish/tuna

    Fish/tuna-2

    Fish/shark

    Fish/shark-2

    Fish/trout

     

    Any relatively easy way of doing it? Note that this is a simplified version as I have 50,000 rows that need this, and the highest number of rows that need to be repeated for any one item is 60.

     

    Thanks in advance!

     

    Friday, August 13, 2010 1:48 PM
  • I found this astounding code that works amazingly on 

    http://www.mrexcel.com/forum/showthread.php?t=239131

    Sub test()
    
    Const lColWithCopyCount As Long = 8
    Const lRowFirstData As Long = 2
    
    Dim iRow As Long
    Dim iCol As Long
    Dim i As Long
    Dim lLastRowSourceData As Long
    Dim lLastColUsed As Long
    Dim lNextRowDestination As Long
    
    Dim arDest As Variant
    Dim arSource As Variant
    
    lLastRowSourceData = Worksheets("Sheet1").Cells(Rows.Count, lColWithCopyCount).End(xlUp).Row
    lLastColUsed = Worksheets("Sheet1").Cells.Find(What:="*", After:=Range("IV65536"), _
            searchorder:=xlByColumns, searchdirection:=xlPrevious).Column
    
    ReDim arDest(1 To 65500, 1 To lLastColUsed)
    ReDim arSource(lRowFirstData To lLastRowSourceData, 1 To lLastColUsed)
    
    arSource = Worksheets("Sheet1").Range(Cells(lRowFirstData, 1), Cells(lLastRowSourceData, lLastColUsed))
    
    lNextRowDestination = lRowFirstData - 1
    For iRow = LBound(arSource) To UBound(arSource)
      For i = 1 To arSource(iRow, lColWithCopyCount)
        For iCol = 1 To lLastColUsed
          arDest(lNextRowDestination + i, iCol) = arSource(iRow, iCol)
        Next iCol
      Next i
      lNextRowDestination = lNextRowDestination + arSource(iRow, lColWithCopyCount)
    Next iRow
    
    Worksheets("Sheet2").Range("A1").Resize(lNextRowDestination, lLastColUsed) = arDest
    
    End Sub

    The only problem is that it gives me

    cat 3

    cat 3

    cat 3

    is there any way to get

    cat 1

    cat 2

    cat 3

    Thanks again!

    Saturday, August 14, 2010 10:34 AM
  • Help? Anyone? I really need help! Thanks! 
    Monday, August 16, 2010 11:23 PM