Adding the Last Row as Column in Excel

Question

I have an excel sheet that separates the Classroom details by a blank row and name of the classroom.

I want to generate a new sheet that adds the name of the classroom selected from row tagged as classroom name as a column for each student of the class.

I have tried it multiple time but to no solution.

The image that should be edited to get to the below destination image:

Destination Image to be achievable:

I have tried the following codes but it does not work

Dim ws As Worksheet
Dim wb As Workbook

Sub Copy_data_into_master()
    Dim sno, Row1s As Integer
    Dim ws1, ws2 As Worksheet

    'Macro to copy the data into a master file
    Dim St As Variant

    'Optimize Macro Speed
      Application.ScreenUpdating = False
      Application.EnableEvents = False
      Application.Calculation = xlCalculationManual

    On Error Resume Next
    lastCol = 0
    LastRow = 0
    sno = 0

    Set wb = ThisWorkbook
    Set ws = ThisWorkbook.Worksheets("temp")
    'Set ws2 = ThisWorkbook.Worksheets("Sheet1")
    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    'Deleting current data
    'If ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row > 1 Then
    '    ws2.Range("A2:G" & ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row).Clear
    'End If
    sno = 0


    'Loop through each Excel file in folder

    '    For Row1s = 0 To LastRow
    '    For col1 = 0 To lastCol
    '        If ws1.Range("A1").Offset(Row1s, col1).Value = "** SUMME PSP-ELEMENT" Then
    '        'Set St = ws1.Range("A1").Offset(4, col1).Value
                Call copy_data(wb, ws)
    '        End If
    '    Next
    'Next
        'wb.Close SaveChanges:=False



    'MsgBox "Copy Complete!"

    ResetSettings:
      'Reset Macro Optimization Settings
        Application.EnableEvents = True
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True

End Sub



Sub copy_data(wb1 As Workbook, ws1 As Worksheet)
    Dim ws2 As Worksheet
    Dim lastCol, LastRow As Integer
    Dim col1, row1 As Integer
    Set ws2 = Worksheets.Add
    Dim EntireRow As Range
    Dim SourceRange As Range
    Dim Nachname_col, Aufnr_col, empid_col, Text_col, Vorname_col, Ist_col, as_col As Long

    'lastCol = ws1.Cells(4, ws1.Columns.Count).End(xlToLeft).Column
    lastCol = ws1.UsedRange.Columns(ws1.UsedRange.Columns.Count).Column
    LastRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
    name_col = 1000
    secondname_col = 1000
    proj_col = 1000
    days_col = 1000
    rate_col = 1000
    total_col = 1000
    Fixedcost_col = 1000

    For I = SourceRange.Rows.Count To 1 Step -1
                Set EntireRow = SourceRange.Cells(I, 1).EntireRow
                If Application.WorksheetFunction.CountA(EntireRow) = 0 Then
                    EntireRow.Delete
                End If

    With ws2.Range("A1")
        For col1 = 0 To lastCol
            If ws1.Range("A1").Offset(0, col1).Value Like "Name" Then
                Nachname_col = col1
            ElseIf ws1.Range("A1").Offset(5, col1).Value Like "Aufnr" Then
                Aufnr_col = col1
            ElseIf ws1.Range("A1").Offset(4, col1).Value Like "Text" Then
                Text_col = col1
            ElseIf ws1.Range("A1").Offset(3, col1).Value Like "Vorname" Then
                Vorname_col = col1
            ElseIf ws1.Range("A1").Offset(1, col1).Value Like "Ist" Then
                Ist_col = col1
            ElseIf ws1.Range("A1").Offset(2, col1).Value Like "as" Then
                as_col = col1
            End If
        Next col1

    '

        For row1 = 0 To LastRow - 1
    '        If ws1.Range("A1").Offset(row1, 0).Value = "* SUMME VORGANG" Then
    '            Exit For
    '        Else
    '            sno = sno + 1
                .Offset(sno, 0).Value = wb1.Name
                .Offset(sno, 1).Value = ws1.Range("A1").Offset(row1, Nachname_col).Value
                .Offset(sno, 2).Value = ws1.Range("A1").Offset(row1, Aufnr_col).Value
                .Offset(sno, 3).Value = ws1.Range("A1").Offset(row1, Text_col).Value
                .Offset(sno, 4).Value = ws1.Range("A1").Offset(row1, Vorname_col).Value
                .Offset(sno, 5).Value = ws1.Range("A1").Offset(row1, Ist_col).Value
                .Offset(sno, 6).Value = ws1.Range("A1").Offset(row1, as_col).Value


        Next row1

    End With

End Sub

The expected output sheet is attached

The code should also delete blank rows from the excel.

a) *"Does not work"* is not an error desciption. It is completly useless. b) There is no question ([Why is “Can someone help me?” not an actual question?](https://meta.stackoverflow.com/a/284237/3219613)) c) Please read what a [mcve] is and provide one instead of throwing in your whole code. d) we need a clear problem statement ([ask]) and we need to know where exactly you got errors. You must remove `On Error Resume Next` to see your errors. — Pᴇʜ, Oct 22 '19 at 10:09
Note that if you declare `Dim ws1, ws2 As Worksheet` only `ws2` is of type `Worksheet` and `ws1` is `Variant`. You must declare a type for **every** variable in VBA or it is `Variant` by default: `Dim ws1 As Worksheet, ws2 As Worksheet`. • Also all row counting variables *must* be of type `Long` Excel has more rows than `Integer` can handle. I recommend [always to use `Long` instead of `Integer`](https://stackoverflow.com/questions/26409117/why-use-integer-instead-of-long/26409520#26409520) as there is no benefit in using `Integer`. • You should fix this and tidy up your code. — Pᴇʜ, Oct 22 '19 at 10:12
Is it an accident that the names in the second shot are different? — SJR, Oct 22 '19 at 10:42
Your screenshot of data is virtually useless for doing proper troubleshooting. It cannot be copy/pasted into a worksheet. One can try an OCR program, or manually enter it. Having to do either of these is discouraging to those who might assist you. To make the data useful edit your question to post it as text, perhaps using this [Markdown Tables Generator](https://www.tablesgenerator.com/markdown_tables), or possibly upload a workbook (with sensitive information removed) to some public website and post a link in your original question (although many won't download a workbook from the Web). — Ron Rosenfeld, Oct 22 '19 at 12:07
Should be pretty easy to do with `Power Query`, available in Excel 2010+ — Ron Rosenfeld, Oct 22 '19 at 12:43
@RonRosenfeld You are right the images are pretty useless for testing but I think uploading files is against the idea of SO having all you need to repoduce the issue *in the question itself*. If a link disappears the question gets useless (again) for future readers. • A [mcve] with a small set of data (as text seperated by tab/spaces) would always be preferable and meet the SO rules. — Pᴇʜ, Oct 22 '19 at 13:29
@PEH I agree but sometimes text representation can be overly complex. — Ron Rosenfeld, Oct 22 '19 at 13:33

score 0 · Answer 1 · edited Jun 20 '20 at 09:12

You can do this fairly simply with Power Query aka Get & Transform available in Excel 2010 and later.

Get from Table/Range
Add a Conditional Column and NAME it Classroom

Select the Classroom Column and Fill Up
Filter on Column 1 using Text <> Classroom Name

Result

M-Code

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Column1", type text}, {"Column2", type text}, {"Column3", Int64.Type}, {"Column4", type any}, {"Column5", type text}, {"Column6", type number}, {"Column7", type text}}),
    #"Added Conditional Column" = Table.AddColumn(#"Changed Type", "Classroom", each if [Column1] = "Classroom Name" then [Column4] else null),
    #"Filled Up" = Table.FillUp(#"Added Conditional Column",{"Classroom"}),
    #"Filtered Rows" = Table.SelectRows(#"Filled Up", each [Column1] <> "Classroom Name")
in
    #"Filtered Rows"

Adding the Last Row as Column in Excel

1 Answers1

Result

M-Code