VBA help needed. How to extract values from a table to itemised as 3 column data

Joined
Jan 5, 2012
Messages
38
Hello Forum,
I was wondering if you can help me with a vba code to extract values from a table like this to multiple rows of 3 columns only.

Name of Students
ApplesLemonOrangesPineappleStrawberryGrapeLimeCoconut
Peter421
John
Derrick31
Stuart7
Paul7
Mary
Jim
Susan92
Dorothy
Rick11
Michael

<tbody>
</tbody>

Desired outcome is this

PeterApples4
PeterPineapple2
PeterStrawberry1
DerrickOranges3
DerrickLime1
StuartLemon7
PaulLemon7
SusanLemon9
Susan Coconut2
The logic continues

<tbody>
</tbody>


Thank you!
 

Comfy

Well-known Member
Joined
Dec 21, 2009
Messages
3,376
Code:
Sub Transpose()
Dim LastRow As Long, LastCol As Long, i As Long, j As Long, output As Long
Dim Student As String


LastCol = Cells(1, 1).End(xlToRight).Column
LastRow = Cells(1, 1).End(xlDown).Row
output = LastRow + 2


For i = 2 To LastRow
Student = Cells(i, 1).Value
    For j = 2 To LastCol
        If Cells(i, j).Value <> "" Then Cells(output, 1).Value = Student: Cells(output, 2).Value = Cells(1, j).Value: Cells(output, 3).Value = Cells(i, j).Value: output = output + 1
    Next j
Next i


End Sub
 
Joined
Jan 5, 2012
Messages
38
Hello Comfy! Good morning! Thank you so so much for helping me. I tried the codes and it worked very well! I want to ask for your help to modify this a little bit as I saw that the results are displayed in the same sheet and at the bottom. Because I need to use the results to upload to a database, would it be possible to have the result be done on a Sheet2 starting from cell A1? And then the final step would be then to delete this Sheet1 once the steps are complete? Then sheet2 (the results) would remain as the only sheet on this workbook.

This would be what I hope to accomplished! Thank you!:)
 
Joined
Jan 5, 2012
Messages
38
Hello Andrew
Good morning. Thank you for your help! I was able to visit the URL link and then I saw the VBA codes. I tried the VBA codes but the results were that even the blank entries (ie there are no values) would be displayed as a row. I have many empty rows where the student don't have any fruits and I want to delete this row. I only need rows to show where there are actual numbers.

I was looking elsewhere in the forum to see if I could get a code to search for column C in the results and then to delete the whole row if there is nothing in column C. This would then trim and eliminate the empty data rows. However, because the results are shown in a dynamic cell (the VBA code prompt and ask the use to select the cell to start the result display area), I wasn't able to effectively use the code below.
It doesn't work well

Sub test()On Error Resume NextWith Sheets1 .Columns("C").SpecialCells(xlCellTypeBlanks).EntireRow.DeleteEnd WithEnd Sub</pre>
 

Comfy

Well-known Member
Joined
Dec 21, 2009
Messages
3,376
would it be possible to have the result be done on a Sheet2 starting from cell A1? And then the final step would be then to delete this Sheet1 once the steps are complete? Then sheet2 (the results) would remain as the only sheet on this workbook.
updated.

Code:
Sub Transpose()
Dim LastRow As Long, LastCol As Long, i As Long, j As Long, output As Long
Dim Student As String
Dim ws1 As Worksheet, ws2 As Worksheet


Application.DisplayAlerts = False


Set ws1 = ActiveSheet
Set ws2 = Sheets.Add


LastCol = ws1.Cells(1, 1).End(xlToRight).Column
LastRow = ws1.Cells(1, 1).End(xlDown).Row
output = 1


For i = 2 To LastRow
Student = ws1.Cells(i, 1).Value
    For j = 2 To LastCol
        If ws1.Cells(i, j).Value <> "" Then ws2.Cells(output, 1).Value = Student: ws2.Cells(output, 2).Value = ws1.Cells(1, j).Value: ws2.Cells(output, 3).Value = ws1.Cells(i, j).Value: output = output + 1
    Next j
Next i


ws1.Delete


Application.DisplayAlerts = True
End Sub
 
Joined
Jan 5, 2012
Messages
38
Hello Comfy,
thank you. It works very well!


updated.

Code:
Sub Transpose()
Dim LastRow As Long, LastCol As Long, i As Long, j As Long, output As Long
Dim Student As String
Dim ws1 As Worksheet, ws2 As Worksheet


Application.DisplayAlerts = False


Set ws1 = ActiveSheet
Set ws2 = Sheets.Add


LastCol = ws1.Cells(1, 1).End(xlToRight).Column
LastRow = ws1.Cells(1, 1).End(xlDown).Row
output = 1


For i = 2 To LastRow
Student = ws1.Cells(i, 1).Value
    For j = 2 To LastCol
        If ws1.Cells(i, j).Value <> "" Then ws2.Cells(output, 1).Value = Student: ws2.Cells(output, 2).Value = ws1.Cells(1, j).Value: ws2.Cells(output, 3).Value = ws1.Cells(i, j).Value: output = output + 1
    Next j
Next i


ws1.Delete


Application.DisplayAlerts = True
End Sub
 

Forum statistics

Threads
1,082,273
Messages
5,364,163
Members
400,784
Latest member
reddsables

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top