VBA to copy specific cells from one worksheet to another upon meeting a criteria - excel

Question

My VBA knowledge is very limited, so looking for some help here. Tried some Googling and putting together a code but hasn't met the goal. Appreciate the help here!
I have 2 worksheets:
Data - source worksheet with the data to be copied
Dashboard - Target sheet for pasting
Data sheet - It has multiple columns, the ones I have named are the ones I need to be copied except the column named "Sold?" which is for criteria. The other columns with no names in the image actually have data, to avoid confusion I have removed them here.
This sheet grows and I will add a new row of data when needed.
Dashboard Sheet - When I click "Refresh" button, I want the code to check the "Data" sheet and if a row meets of criteria of Sold? = "N", then only data from column C,G,J,M should be copied and pasted into columns B,C,D,E of "Dashboard" sheet. Additional criteria: if an investment name repeats, the details need to be summed up and shown in Dashboard sheet. I have provided my expected output in the image. (ABC & TY summed up)
I have tried a bit but unable to incorporate all the criteria and this code when run doesn't throw an error but does nothing, no output.
Private Sub Refresh_Click()
Worksheets("Dashboard").Activate
Application.ScreenUpdating = True
a = Worksheets("Data").Cells(Rows.Count, "A").End(xlUp).Row
For i = 12 To a
If Worksheets("Data").Cells(i, 15).Value = "N" Then
Worksheets("Data").Cells(i, 3).Copy
Worksheets("Data").Cells(i, 7).Copy
Worksheets("Data").Cells(i, 13).Copy
Worksheets("Data").Cells(i, 14).Copy
Worksheets("Dashboard").Activate
Worksheets("Dashboard").Range("B6:G25").Select
ActiveSheet.Paste
End If
Next
Application.CutCopyMode = False
End Sub

Answer 1

I strongly suggest a pivot table. Still if you want VBA based solution, you might try this code:
Option Explicit
Private Sub Refresh_Click()
'Declarations.
Dim BlnHiddenColumns() As Boolean
Dim DblFirstRow As Double
Dim DblLastRow As Double
Dim DblCounter01 As Double
Dim DblCounterLimit01 As Double
Dim DblInvestmentNameColumn As Double
Dim DblQuantityColumn As Double
Dim DblAfterChargeColumn As Double
Dim DblCurrentPLColumn As Double
Dim DblSoldColumn As Double
Dim RngData As Range
Dim RngResult As Range
Dim StrAutofilterAddress As String
Dim StrMarker As String
Dim StrInvestmentNameHeader As String
Dim StrQuantityHeader As String
Dim StrAfterChargeHeader As String
Dim StrCurrentPLHeader As String
Dim WksData As Worksheet
Dim WksDashboard As Worksheet
Dim WksPivotTable As Worksheet
Dim PvtPivotTable01 As PivotTable
'Settings.
DblInvestmentNameColumn = 3
DblQuantityColumn = 7
DblAfterChargeColumn = 10
DblCurrentPLColumn = 13
DblSoldColumn = 15
DblFirstRow = 12
DblCounterLimit01 = 1000
StrMarker = "N"
Set WksData = Worksheets("Data")
DblLastRow = WksData.Cells(Rows.Count, "B").End(xlUp).Row
Set RngData = WksData.Range(WksData.Cells(DblFirstRow - 1, Excel.WorksheetFunction.Min(DblInvestmentNameColumn, DblQuantityColumn, DblAfterChargeColumn, DblCurrentPLColumn, DblSoldColumn)), WksData.Cells(DblLastRow, Excel.WorksheetFunction.Max(DblInvestmentNameColumn, DblQuantityColumn, DblAfterChargeColumn, DblCurrentPLColumn, DblSoldColumn)))
ReDim BlnHiddenColumns(1 To RngData.Columns.Count)
Set WksDashboard = Worksheets("Dashboard")
Set RngResult = WksDashboard.Range("B6")
StrInvestmentNameHeader = WksDashboard.Range("B5").Value
StrQuantityHeader = WksDashboard.Range("C5").Value
StrAfterChargeHeader = WksDashboard.Range("D5").Value
StrCurrentPLHeader = WksDashboard.Range("E5").Value
'Turning off screen updating.
Application.ScreenUpdating = False
'Checking for any previous results list.
If Excel.WorksheetFunction.CountBlank(RngResult) <> RngResult.Cells.Count Then
DblCounter01 = 0
'Checking each row of the result list until an entirely blank row is found.
Do Until Excel.WorksheetFunction.CountBlank(RngResult.Offset(DblCounter01, 0)) = RngResult.Cells.Count
DblCounter01 = DblCounter01 + 1
'If the number of rows checked is equal or superior to DblCounterLimit01 the macro is terminated.
If DblCounter01 >= DblCounterLimit01 Then
MsgBox "Please clear the current holdings list manually", vbCritical + vbOKOnly, "Unable to clear the current list"
Exit Sub
End If
Loop
'Clearing the list.
RngResult.Parent.Range(RngResult, RngResult.Offset(DblCounter01 - 1)).ClearContents
End If
'Checking for existing autofilter in WksData.
If WksData.AutoFilterMode = True Then
'Coping the address of the autofilter in WksData.
StrAutofilterAddress = WksData.AutoFilter.Range.Address
End If
'Removing any autofilter in WksData.
WksData.AutoFilterMode = False
'Covering each column of RngData.
For DblCounter01 = 1 To RngData.Columns.Count
'Setting BlnHiddenColumns accordingly to the RngData columns' status (hidden/not hidden).
BlnHiddenColumns(DblCounter01) = RngData.Columns(DblCounter01).Hidden
'Hiding the columns of RngData we won't copy.
Select Case DblCounter01 + RngData.Column - 1
Case Is = DblInvestmentNameColumn, DblQuantityColumn, DblAfterChargeColumn, DblCurrentPLColumn
RngData.Columns(DblCounter01).Hidden = False
Case Else
RngData.Columns(DblCounter01).Hidden = True
End Select
Next
'Filtering RngData.
RngData.AutoFilter Field:=DblSoldColumn - RngData.Column + 1, Criteria1:=StrMarker
'Copying the filtered RngData into RngResult.
RngData.Resize(RngData.Rows.Count - 1, RngData.Columns.Count).Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy RngResult
'Restoring the RngData columns to their previous status (hidden/not hidden).
For DblCounter01 = 1 To RngData.Columns.Count
If BlnHiddenColumns(DblCounter01) Then
RngData.Columns(DblCounter01).Hidden = True
Else
RngData.Columns(DblCounter01).Hidden = False
End If
Next
'Removing any autofilter in WksData.
WksData.AutoFilterMode = False
'Restoring any pre-existing autofilter in WksData.
If StrAutofilterAddress <> "" Then
WksData.Range(StrAutofilterAddress).AutoFilter
End If
'Setting RngResult to cover the imported list (headers included).
Set RngResult = RngResult.Offset(-1, 0)
Set RngResult = WksDashboard.Range(RngResult, RngResult.End(xlDown).End(xlToRight))
'Creating WksPivotTable.
Set WksPivotTable = Sheets.Add
'Creating PvtPivotTable01.
Set PvtPivotTable01 = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:=RngResult, _
Version:=7 _
).CreatePivotTable(TableDestination:=WksPivotTable.Cells(1, 1), _
TableName:="Temporary Pivot Table", _
DefaultVersion:=7 _
)
'Setting PvtPivotTable01.
With PvtPivotTable01.PivotFields(StrInvestmentNameHeader)
.Orientation = xlRowField
.Position = 1
End With
With PvtPivotTable01
.AddDataField .PivotFields(StrQuantityHeader), "Sum of " & StrQuantityHeader, xlSum
.AddDataField .PivotFields(StrAfterChargeHeader), "Sum of " & StrAfterChargeHeader, xlSum
.AddDataField .PivotFields(StrCurrentPLHeader), "Sum of " & StrCurrentPLHeader, xlSum
.ColumnGrand = False
End With
'Clearing the data from RngResult.
RngResult.Offset(1, 0).Resize(RngResult.Rows.Count - 1).ClearContents
'Copying the PvtPivotTable01 content to RngResult.
PvtPivotTable01.DataBodyRange.Offset(0, -1).Resize(, PvtPivotTable01.DataFields.Count + 1).Copy RngResult.Cells(2, 1)
'Deleting WksPivotTable.
Application.DisplayAlerts = False
WksPivotTable.Delete
Application.DisplayAlerts = True
'Restoring screen updating.
Application.ScreenUpdating = False
End Sub
I've intentionally made it longer than the necessary, especially by creating many variables to avoid hard coded data. This method might be useful in more complex and/or longer codes.