PDA

View Full Version : [SOLVED] VBA code for selecting data from statement to output sheet



yash47
12-02-2019, 12:34 PM
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
12-02-2019, 12:49 PM
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
12-02-2019, 01:31 PM
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
12-03-2019, 06:28 AM
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
12-03-2019, 08:01 AM
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
12-03-2019, 08:20 AM
Thanks a lot. It worked like a charm. :hi:

yash47
12-03-2019, 08:22 AM
Thanks. I will make it a point to learn Power Query, seems to be the way of future.

yash47
12-03-2019, 08:44 AM
Just a query. Is it possible to paste the values of "Repayment" in Column D, instead of Column C (currently)?

yash47
12-05-2019, 12:36 PM
Hi, is it possible to paste the "values" of "Repayment" in Column D, instead of Column C (currently)?

JKwan
12-05-2019, 12:51 PM
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
12-05-2019, 11:10 PM
Thank you very much.