VBA code for selecting data from statement to output sheet

[yash47]

Hi,

i am trying to copy data from Input sheet and paste it in Output sheet in the format given. Please help with the relevant VBA codes to get the data displayed in Output Sheet. (File attached)

Regards.

[Bob Phillips]

Use Power Query

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Date", type datetime}, {"Interest of EMI", type number}, {"Interest & charges", type number}, {"Repayment", Int64.Type}}),
    #"Unpivoted Other Columns" = Table.UnpivotOtherColumns(#"Changed Type", {"Date"}, "Attribute", "Value"),
    #"Changed Type1" = Table.TransformColumnTypes(#"Unpivoted Other Columns",{{"Value", Int64.Type}}),
    #"Filtered Rows" = Table.SelectRows(#"Changed Type1", each ([Value] <> 0))
in
    #"Filtered Rows"

[yash47]

Thanks for such a prompt reply and taking effort to write down the query. I am not so conversant with Power Query. Is it possible for code (module) which can be used in Excel in VBA?
Thanks

[Bob Phillips]

I can do that for you, but Power Query is worth learning, MS are investing far more in it than they ever will again in VBA.

[JKwan]

Option Explicit
Sub Blah()
    Dim LastRow As Long
    Dim lRow As Long
    Dim lCol As Long
    Dim lRowCount As Long
    Dim WS As Worksheet
    Dim WSOut As Worksheet
    
    Set WS = ThisWorkbook.Worksheets("Input")
    Set WSOut = ThisWorkbook.Worksheets("Output")
    LastRow = FindLastRow(WS, "A")
    lRowCount = 2
    With WSOut
        For lRow = 2 To LastRow
            For lCol = 2 To 4
                Select Case WS.Cells(lRow, lCol)
                    Case Is > 0
                        .Cells(lRowCount, "A") = WS.Cells(lRow, "A")
                        .Cells(lRowCount, "B") = WS.Cells(1, lCol)
                        .Cells(lRowCount, "C") = WS.Cells(lRow, lCol)
                        lRowCount = lRowCount + 1
                End Select
            Next lCol
        Next lRow
    End With
    
    Set WS = Nothing
    Set WSOut = Nothing
End Sub
Function FindLastRow(ByVal WS As Worksheet, ColumnLetter As String) As Long
    FindLastRow = WS.Range(ColumnLetter & Rows.Count).End(xlUp).Row
End Function

[yash47]

Thanks a lot. It worked like a charm.

[yash47]

Thanks. I will make it a point to learn Power Query, seems to be the way of future.

[yash47]

Just a query. Is it possible to paste the values of "Repayment" in Column D, instead of Column C (currently)?

[yash47]

Hi, is it possible to paste the "values" of "Repayment" in Column D, instead of Column C (currently)?

[JKwan]

Option Explicit
Sub Blah()
    Dim LastRow As Long
    Dim lRow As Long
    Dim lCol As Long
    Dim lRowCount As Long
    Dim WS As Worksheet
    Dim WSOut As Worksheet
    
    Set WS = ThisWorkbook.Worksheets("Input")
    Set WSOut = ThisWorkbook.Worksheets("Output")
    LastRow = FindLastRow(WS, "A")
    lRowCount = 2
    With WSOut
        For lRow = 2 To LastRow
            For lCol = 2 To 4
                Select Case WS.Cells(lRow, lCol)
                    Case Is > 0
                        .Cells(lRowCount, "A") = WS.Cells(lRow, "A")
                        .Cells(lRowCount, "B") = WS.Cells(1, lCol)
                        If InStr(WS.Cells(1, lCol), "Repayment") Then
                            .Cells(lRowCount, "D") = WS.Cells(lRow, lCol)
                        Else
                            .Cells(lRowCount, "C") = WS.Cells(lRow, lCol)
                        End If
                        lRowCount = lRowCount + 1
                End Select
            Next lCol
        Next lRow
    End With
    
    Set WS = Nothing
    Set WSOut = Nothing
End Sub
Function FindLastRow(ByVal WS As Worksheet, ColumnLetter As String) As Long
    FindLastRow = WS.Range(ColumnLetter & Rows.Count).End(xlUp).Row
End Function

[yash47]

Thank you very much.