Need help in writing a VBA code

[imereysoriano]

C​	D​	E​	F​	G​
Session Code	Demo	Practical	Lecture	Seminar
D01	3	3
D02			3	3

In the example table above, I would like to write a VBA code to list the Session Code + Lesson Type like this

D01 Demo
D01 Practical
D02 Lecture
D02 Seminar

I was able to look for a code but it just gives me the cell address that matches a criteria. Here's the code

Public Sub SearchForText()
Dim rngSearchRange As Range
Dim vntTextToFind As Variant
Dim strFirstAddr As String
Dim lngMatches As Long
Dim rngFound As Range

On Error GoTo ErrHandler
vntTextToFind = Application.InputBox( _
Prompt:="Enter text to find:", _
Default:="Search...", _
Type:=2 _
)
If VarType(vntTextToFind) = vbBoolean Then Exit Sub

On Error Resume Next
Set rngSearchRange = Application.InputBox( _
Prompt:="Enter range for search:", _
Default:=ActiveCell.Parent.UsedRange.Address, _
Type:=8 _
)

On Error GoTo ErrHandler
If rngSearchRange Is Nothing Then Exit Sub
Set rngFound = rngSearchRange.Find( _
What:=CStr(vntTextToFind), _
LookIn:=xlValues, _
LookAt:=xlPart _
)

If rngFound Is Nothing Then
MsgBox "No matches were found.", vbInformation
Else
With ThisWorkbook.Sheets.Add
With .Range("A1:B1")
.Value = Array("Cell", "Value")
.Font.Bold = True
End With
strFirstAddr = rngFound.Address
Do
lngMatches = lngMatches + 1
.Cells(lngMatches + 1, "A").Value = rngFound.Parent.Name & "!" _
& rngFound.Address(0, 0)
.Cells(lngMatches + 1, "B").Value = rngFound.Value
Set rngFound = rngSearchRange.FindNext(rngFound)
Loop Until (rngFound.Address = strFirstAddr)
.Columns("A:B").AutoFit
End With
End If
Exit Sub

ErrHandler:
MsgBox Err.Description, vbExclamation
End Sub

Would really appreciate your help. Thanks.

 

[Kerryx]

PQ can do it for you easily

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Session Code", type text}, {"Demo", Int64.Type}, {"Practical", Int64.Type}, {"Lecture", Int64.Type}, {"Seminar", Int64.Type}}),
    #"Unpivoted Columns" = Table.UnpivotOtherColumns(#"Changed Type", {"Session Code"}, "Attribute", "Value"),
    #"Removed Columns" = Table.RemoveColumns(#"Unpivoted Columns",{"Value"})
in
    #"Removed Columns"

Book1
	A	B	C	D	E
1	Session Code	Demo	Practical	Lecture	Seminar
2	D01	3	3
3	D02			3	3
4
5
6	Session Code	Attribute
7	D01	Demo
8	D01	Practical
9	D02	Lecture
10	D02	Seminar
Sheet1

 

[imereysoriano]

PQ can do it for you easily

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Session Code", type text}, {"Demo", Int64.Type}, {"Practical", Int64.Type}, {"Lecture", Int64.Type}, {"Seminar", Int64.Type}}),
    #"Unpivoted Columns" = Table.UnpivotOtherColumns(#"Changed Type", {"Session Code"}, "Attribute", "Value"),
    #"Removed Columns" = Table.RemoveColumns(#"Unpivoted Columns",{"Value"})
in
    #"Removed Columns"

Book1
	A	B	C	D	E
1	Session Code	Demo	Practical	Lecture	Seminar
2	D01	3	3
3	D02			3	3
4
5
6	Session Code	Attribute
7	D01	Demo
8	D01	Practical
9	D02	Lecture
10	D02	Seminar
Sheet1

Hello. Thanks for the response.

Sorry. I am not familiar with power query. I am currently using just Excel.
How can I convert my file to PQ if I may ask?

 

[Kerryx]

Power Query is part of Excel and very powerful for handling large data set transformations / sorting

Select the range of the data you are importing, paste into Advanced editor the code above and load back into your excel sheet . Loads of resources on how to use it available and walkthroughs

 

[imereysoriano]

Power Query is part of Excel and very powerful for handling large data set transformations / sorting

View attachment 94123

Select the range of the data you are importing, paste into Advanced editor the code above and load back into your excel sheet . Loads of resources on how to use it available and walkthroughs

Got this. This is very helpful.

Is there a way I can add a macro to have this done?

 

[Kerryx]

To do what? Once you have this set up and if the data changes in the worksheet , if the range has not changed just refresh, if the range has changed just amend the range and rerun. You don't need a macro.
PQ Step-by-step

 

[imereysoriano]

To do what? Once you have this set up and if the data changes in the worksheet , if the range has not changed just refresh, if the range has changed just amend the range and rerun. You don't need a macro.
PQ Step-by-step

Got your point. I am now able to do it. Thank you