VBA Make a row of Data Based on Column A & B

[Stephen_IV]

Good Morning,
I have about 90000 rows of data. What I need to do is to make 1 line of data based on Column A and B on Sheet 2. Thanks in advance.
<style type="text/css">
table.tableizer-table {
font-size: 8px;
border: 1px solid #CCC ;
font-family: Arial, Helvetica, sans-serif;
}
.tableizer-table td {
padding: 4px;
margin: 3px;
border: 1px solid #CCC ;
}
.tableizer-table th {
background-color: #104E8B ;
color: #FFF ;
font-weight: bold;
}
</style>
<table class="tableizer-table">
<thead><tr class="tableizer-firstrow"><th>SSID</th><th>Subject</th><th>Tool Name</th><th>Value</th></tr></thead><tbody>
<tr><td>1111</td><td>ELA</td><td>Color Contrast</td><td>Black on White</td></tr>
<tr><td>1111</td><td>ELA</td><td>Non-Embedded Designated Supports</td><td>Separate Setting</td></tr>
<tr><td>1111</td><td>ELA</td><td>Non-Embedded Designated Supports</td><td>Simplified Test Directions</td></tr>
<tr><td>1111</td><td>ELA</td><td>Presentation</td><td>English</td></tr>
<tr><td>1111</td><td>ELA</td><td>Translations (Glossaries)</td><td>English Glossary</td></tr>
<tr><td>1111</td><td>Mathematics</td><td>Color Contrast</td><td>Black on White</td></tr>
<tr><td>1111</td><td>Mathematics</td><td>Non-Embedded Accommodations</td><td>Multiplication Table</td></tr>
<tr><td>1111</td><td>Mathematics</td><td>Non-Embedded Designated Supports</td><td>Separate Setting</td></tr>
<tr><td>1111</td><td>Mathematics</td><td>Presentation</td><td>English</td></tr>
<tr><td>1111</td><td>Science</td><td>Color Contrast</td><td>Black on White</td></tr>
<tr><td>2222</td><td>ELA</td><td>Color Contrast</td><td>Black on White</td></tr>
<tr><td>2222</td><td>ELA</td><td>Non-Embedded Designated Supports</td><td>Separate Setting</td></tr>
<tr><td>2222</td><td>ELA</td><td>Presentation</td><td>English</td></tr>
<tr><td>2222</td><td>ELA</td><td>Translations (Glossaries)</td><td>English Glossary</td></tr>
<tr><td>2222</td><td>ELA</td><td>TTS</td><td>Items</td></tr>
</tbody></table>
<style type="text/css">
table.tableizer-table {
font-size: 8px;
border: 1px solid #CCC ;
font-family: Arial, Helvetica, sans-serif;
}
.tableizer-table td {
padding: 4px;
margin: 3px;
border: 1px solid #CCC ;
}
.tableizer-table th {
background-color: #104E8B ;
color: #FFF ;
font-weight: bold;
}
</style>
<table class="tableizer-table">
<thead><tr class="tableizer-firstrow"><th>ID</th><th>Subject</th><th>Tool Name</th><th>Value</th><th>Tool Name</th><th>Value</th><th>Tool Name</th><th>Value</th><th>Tool Name</th><th>Value</th><th>Tool Name</th><th>Value</th></tr></thead><tbody>
<tr><td>1111</td><td>ELA</td><td>Color Contrast</td><td>Black on White</td><td>Non-Embedded Designated Supports</td><td>Separate Setting</td><td>Non-Embedded Designated Supports</td><td>Simplified Test Directions</td><td>Presentation</td><td>English</td><td>Translations (Glossaries)</td><td>English Glossary</td></tr>
<tr><td>1111</td><td>Mathematics</td><td>Color Contrast</td><td>Black on White</td><td>Non-Embedded Accommodations</td><td>Multiplication Table</td><td>Non-Embedded Designated Supports</td><td>Separate Setting</td><td>Presentation</td><td>English</td><td> </td><td> </td></tr>
<tr><td>1111</td><td>Science</td><td>Color Contrast</td><td>Black on White</td><td> </td><td> </td><td> </td><td> </td><td> </td><td> </td><td> </td><td> </td></tr>
<tr><td>2222</td><td>ELA</td><td>Color Contrast</td><td>Black on White</td><td>Non-Embedded Designated Supports</td><td>Separate Setting</td><td>Presentation</td><td>English</td><td>Translations (Glossaries)</td><td>English Glossary</td><td>TTS</td><td>Items</td></tr>
</tbody></table>

 

[kvsrinivasamurthy]

Input DATA in Sheet1 Range B4:E19

Output data in Sheet2 Range A8:L12

ARRAY formulas

IN A9 then drag across upto B12

=IFERROR(INDEX(Sheet1!B$5:B$19,SMALL(IF(COUNTIFS($A$8:$A8,Sheet1!$B$5:$B$19,$B$8:$B8,Sheet1!$C$5:$C$19)=0,ROW($C$5:$C$19),""),1)-ROW($C$5)+1),"")

IN C9 then drag across upto L12

=IFERROR(INDEX(Sheet1!$D$5:$E$19,SMALL(IF(Sheet2!$A9&Sheet2!$B9=Sheet1!$B$5:$B$19&Sheet1!$C$5:$C$19,ROW($C$5:$C$19),""),1+INT((COLUMNS($C9:C9)-1)/2))-ROW($C$5)+1,MATCH(C$8,Sheet1!$D$4:$E$4,0)),"")

ARRAY formula is used


To enter ARRAY formula
Paste the formula
Press F2
Press Ctrl+Shift+Enter keys together.
formula will be covered with{} brackets by excel.

 

[Stephen_IV]

kvsrinivasamurthy thank you for taking the time and responding to my post. Your formulas work with a small data set but I need VBA with all of the rows of data that I have. Anyone willing to take a stab at it? Thanks in advance!

 

[Peter_SSs]

Assuming that Sheet2 already exists but anything on it can be removed, try this in a copy of your workbook.
Note that I have not tested this on data as large as yours.

Sub Rearrange()
  Dim a As Variant, b As Variant, e As Variant, Bits As Variant
  Dim d As Object
  Dim i As Long, j As Long, k As Long, Mx As Long, n As Long
  Dim SSIDSubj As String, tmp As String
  
  Set d = CreateObject("Scripting.Dictionary")
  d.CompareMode = 1
  a = Sheets("Sheet1").Range("A1").CurrentRegion.Value
  For i = 2 To UBound(a)
    SSIDSubj = a(i, 1) & "|" & a(i, 2)
    If Not d.exists(SSIDSubj) Then
      d(SSIDSubj) = "0"
    End If
    tmp = d(SSIDSubj)
    n = Left(tmp, InStr(1, tmp & "|", "|") - 1) + 1
    d(SSIDSubj) = Replace(tmp, n - 1, n, 1, 1) & "|" & a(i, 3) & "|" & a(i, 4)
    If n > Mx Then Mx = n
  Next i
  ReDim b(1 To UBound(a), 1 To (Mx + 1) * 2)
  For Each e In d
    k = k + 1
    b(k, 1) = Split(e, "|")(0): b(k, 2) = Split(e, "|")(1)
    Bits = Split(d(e), "|")
    For j = 1 To UBound(Bits)
      b(k, j + 2) = Bits(j)
    Next j
  Next e
  With Sheets("Sheet2")
    .UsedRange.ClearContents
    With .Range("A1").Resize(, UBound(b, 2))
      .Value = Split("ID|Subject" & Replace(String(Mx, "@"), "@", "|Tool Name|Value"), "|")
      .Offset(1).Resize(k).Value = b
      .EntireColumn.AutoFit
    End With
  End With
End Sub

 

[kvsrinivasamurthy]

Input DATA starts in Sheet1 Range B4

Output data starts in Sheet2 Range A14

Try this code

Sub TransferData()
Dim LR As Long, T As Long
Dim K As Double
Dim Sh1 As Worksheet, Sh2 As Worksheet

Set Sh1 = Sheets("Sheet1")
Set Sh2 = Sheets("Sheet2")

LR = Sh1.Range("B" & Rows.Count).End(xlUp).Row
Sh1.Range("B4:E4").Copy Sh2.Range("A14")
Sh2.Range("C14:D14").Copy Sh2.Range("C14:Z14")

With CreateObject("system.collections.arraylist")
    For T = 5 To LR
        If .contains(Sh1.Range("B" & T) & Sh1.Range("C" & T)) Then
        K = .indexof(Sh1.Range("B" & T) & Sh1.Range("C" & T), 0)
        Sh1.Range("D" & T & ":E" & T).Copy Sh2.Range("A" & 15 + K).End(xlToRight).Offset(0, 1)
        Else
        .Add Sh1.Range("B" & T) & Sh1.Range("C" & T)
        Sh1.Range("B" & T & ":E" & T).Copy Sh2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        End If
    Next T

End With

End Sub

 

[Stephen_IV]

Peter_SSs yeah that seemed to do the trick!! Thank you so much for the help on this!! Love dictionary!!! kvsrinivasamurthy thank you for your effort also. You have both taught me something new. Thank you again!

 

[Peter_SSs]

Peter_SSs yeah that seemed to do the trick!! Thank you so much for the help on this!! Love dictionary!!! kvsrinivasamurthy thank you for your effort also. You have both taught me something new. Thank you again!

You are very welcome. Thanks for letting us know.