smart row generator based on columns

M

modiria50989

New Member
Joined
Aug 11, 2017
Messages
32
Hello,

Is there any Excel tool or VBA code to the following efficiently, thank you in advance:

I have a data sheet including a column of color names and a few columns of color codes in front of that. some colors have only 1 code, some 2, and some 3 codes. I need an efficient way that creates new row under a color that has 2 codes, and creates 2 new rows under a color that has 3 codes with the same color name. Unfortunately I don't see an option in this forum to attach my excel sheet. Anyway, for example, the date sheet (4-column) bellow is given and I need to get the second one (2-columns).

Just in case, in average, I'm dealing with a data sheet of "2000 Rows - 50 Columns".


[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD][TABLE="width: 130"]
<tbody>[TR]
[TD="class: xl65, width: 130"]color name[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 61"]
<tbody>[TR]
[TD="class: xl65, width: 61"]code1[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 43"]
<tbody>[TR]
[TD="class: xl65, width: 43"]code2[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 43"]
<tbody>[TR]
[TD="class: xl65, width: 43"]code3[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD][TABLE="width: 130"]
<tbody>[TR]
[TD]Absolute Zero[/TD]
[/TR]
[TR]
[TD]Acajou[/TD]
[/TR]
[TR]
[TD]Acid green[/TD]
[/TR]
[TR]
[TD]Aero[/TD]
[/TR]
[TR]
[TD]Aero blue[/TD]
[/TR]
[TR]
[TD]African violet[/TD]
[/TR]
[TR]
[TD]Air Force blue (RAF)[/TD]
[/TR]
[TR]
[TD]Air Force blue (USAF)[/TD]
[/TR]
[TR]
[TD]Air superiority blue[/TD]
[/TR]
[TR]
[TD]Alabama crimson[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 61"]
<tbody>[TR]
[TD]#0048BA[/TD]
[/TR]
[TR]
[TD]#4C2F27[/TD]
[/TR]
[TR]
[TD]68768[/TD]
[/TR]
[TR]
[TD]#7CB9E8[/TD]
[/TR]
[TR]
[TD]#C9FFE5[/TD]
[/TR]
[TR]
[TD]12863[/TD]
[/TR]
[TR]
[TD]#5D8AA8[/TD]
[/TR]
[TR]
[TD]#00308F[/TD]
[/TR]
[TR]
[TD]#72A0C1[/TD]
[/TR]
[TR]
[TD]#AF002A[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 43"]
<tbody>[TR]
[TD][/TD]
[/TR]
[TR]
[TD]fax[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD]79%[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD]70%[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD]bucks[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD]69%[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 50"]
<tbody>[TR]
[TD][/TD]
[/TR]
[TR]
[TD]18%[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD]man[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD]434436[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]




















[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD][TABLE="width: 130"]
<tbody>[TR]
[TD="class: xl65, width: 130"]color name[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 61"]
<tbody>[TR]
[TD="class: xl65, width: 61"]code[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD][TABLE="width: 130"]
<tbody>[TR]
[TD]Absolute Zero[/TD]
[/TR]
[TR]
[TD]Acajou[/TD]
[/TR]
[TR]
[TD]Acajou[/TD]
[/TR]
[TR]
[TD]Acajou[/TD]
[/TR]
[TR]
[TD]Acid green[/TD]
[/TR]
[TR]
[TD]Aero[/TD]
[/TR]
[TR]
[TD]Aero[/TD]
[/TR]
[TR]
[TD]Aero blue[/TD]
[/TR]
[TR]
[TD]African violet[/TD]
[/TR]
[TR]
[TD]African violet[/TD]
[/TR]
[TR]
[TD]African violet[/TD]
[/TR]
[TR]
[TD]Air Force blue (RAF)[/TD]
[/TR]
[TR]
[TD]Air Force blue (USAF)[/TD]
[/TR]
[TR]
[TD]Air Force blue (USAF)[/TD]
[/TR]
[TR]
[TD]Air superiority blue[/TD]
[/TR]
[TR]
[TD]Alabama crimson[/TD]
[/TR]
[TR]
[TD]Alabama crimson[/TD]
[/TR]
[TR]
[TD]Alabama crimson[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 61"]
<tbody>[TR]
[TD]#0048BA[/TD]
[/TR]
[TR]
[TD]#4C2F27[/TD]
[/TR]
[TR]
[TD]fax[/TD]
[/TR]
[TR]
[TD]18%[/TD]
[/TR]
[TR]
[TD]68768[/TD]
[/TR]
[TR]
[TD]#7CB9E8[/TD]
[/TR]
[TR]
[TD]79%[/TD]
[/TR]
[TR]
[TD]#C9FFE5[/TD]
[/TR]
[TR]
[TD]12863[/TD]
[/TR]
[TR]
[TD]70%[/TD]
[/TR]
[TR]
[TD]man[/TD]
[/TR]
[TR]
[TD]#5D8AA8[/TD]
[/TR]
[TR]
[TD]#00308F[/TD]
[/TR]
[TR]
[TD]bucks[/TD]
[/TR]
[TR]
[TD]#72A0C1[/TD]
[/TR]
[TR]
[TD]#AF002A[/TD]
[/TR]
[TR]
[TD]69%[/TD]
[/TR]
[TR]
[TD]434436[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]
 
Last edited:

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.
Sort by date Sort by votes
Give this macro a bash:

Code: 
Public Sub TransposeData()

Dim lastRow As Long
Dim thisRow As Long
Dim sourceSheet As Worksheet
Dim targetSheet As Worksheet
Dim nextRow As Long
Dim lastCol As Long
Dim thisCol As Long

Set sourceSheet = ActiveSheet
Set targetSheet = Worksheets.Add(after:=sourceSheet)

lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row
nextRow = 0
For thisRow = 2 To lastRow
    lastCol = sourceSheet.Cells(thisRow, sourceSheet.Columns.Count).End(xlToLeft).Column
    For thisCol = 2 To lastCol
        nextRow = nextRow + 1
        sourceSheet.Cells(thisRow, "A").Copy targetSheet.Cells(nextRow, "A")
        sourceSheet.Cells(thisRow, thisCol).Copy targetSheet.Cells(nextRow, "B")
    Next thisCol
Next thisRow

End Sub

WBD
 
Upvote 0
try this: Create two worksheets, Data and Result.

Code: 
Option Explicit




Sub Normalize()
    Dim s1 As Worksheet, s2 As Worksheet
    Dim i As Long, lr As Long, lrt As Long
    Dim lc As Long
    Set s1 = Sheets("Data")
    Set s2 = Sheets("Result")
    lr = s1.Range("A" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False


    For i = 1 To lr
        lrt = s2.Range("B" & Rows.Count).End(xlUp).Row + 1
        lc = s1.Cells(i, Columns.Count).End(xlToLeft).Column
        s1.Range("A" & i).Copy s2.Range("A" & lrt)
        s1.Range(Cells(i, 2), Cells(i, lc)).Copy
        s2.Range("B" & lrt).PasteSpecial xlPasteValues, , , True
        Application.CutCopyMode = False
    Next i


    lrt = s2.Range("B" & Rows.Count).End(xlUp).Row
    For i = 3 To lrt
        If s2.Range("A" & i) = "" Then
            s2.Range("A" & i) = s2.Range("A" & i - 1)
        End If
    Next i


    Application.ScreenUpdating = True


End Sub
 
Upvote 0
Now I am facing with a problem. Your code seems very memory hungry for large databases. It's loading over 1 hour and still loading. Maybe for loop is the problem, I have no idea. Could you please re right this without for loop? or I can send you my file to take a look if you dont mind. Thank you in advance. Just to know that my file has over 250000 rows and 169 columns. So the result would be about 250000*169 rows and 2 columns.


wideboydixon said:
Give this macro a bash:

Code: 
Public Sub TransposeData()

Dim lastRow As Long
Dim thisRow As Long
Dim sourceSheet As Worksheet
Dim targetSheet As Worksheet
Dim nextRow As Long
Dim lastCol As Long
Dim thisCol As Long

Set sourceSheet = ActiveSheet
Set targetSheet = Worksheets.Add(after:=sourceSheet)

lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row
nextRow = 0
For thisRow = 2 To lastRow
    lastCol = sourceSheet.Cells(thisRow, sourceSheet.Columns.Count).End(xlToLeft).Column
    For thisCol = 2 To lastCol
        nextRow = nextRow + 1
        sourceSheet.Cells(thisRow, "A").Copy targetSheet.Cells(nextRow, "A")
        sourceSheet.Cells(thisRow, thisCol).Copy targetSheet.Cells(nextRow, "B")
    Next thisCol
Next thisRow

End Sub

WBD
Click to expand...
 
Upvote 0
This may run a little quicker:

Code: 
Public Sub TransposeData()

Dim lastRow As Long
Dim thisRow As Long
Dim sourceSheet As Worksheet
Dim targetSheet As Worksheet
Dim nextRow As Long
Dim lastCol As Long
Dim thisCol As Long

Application.ScreenUpdating = False

Set sourceSheet = ActiveSheet
Set targetSheet = Worksheets.Add(after:=sourceSheet)

lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row
nextRow = 0
For thisRow = 2 To lastRow
    lastCol = sourceSheet.Cells(thisRow, sourceSheet.Columns.Count).End(xlToLeft).Column
    For thisCol = 2 To lastCol
        nextRow = nextRow + 1
        targetSheet.Cells(nextRow, "A").Value = sourceSheet.Cells(thisRow, "A").Value
        targetSheet.Cells(nextRow, "B").Value = sourceSheet.Cells(thisRow, thisCol).Value
    Next thisCol
Next thisRow

Application.ScreenUpdating = True

End Sub

WBD
 
Upvote 0
In addition to WideBoy's code add a line of code to make the calculation manual.
 
Upvote 0
modiria50989 said:
So the result would be about 250000*169 rows and 2 columns.
Click to expand...
If this is correct then you have a slight problem, as there are only 1,048,576 rows in excel & you're trying to use 42,250,000 rows
[TABLE="width: 64"]
<colgroup><col width="64"></colgroup><tbody>[TR]
[TD="width: 64, align: right"][/TD]
[/TR]
</tbody>[/TABLE]
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

Q
  • Solved
Get the color of a cell from its hexadecimal value
2
Replies
15
Views
4K
ateeqsindhu
A
B
  • Solved
Filter function that must exclude specific data
Replies
7
Views
5K
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,223,910
Messages
6,175,318
Members
452,634
Latest member
cpostell

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top