VBA, Auto filter and copy large amount of data

Question

I am working in a Excel where I look for a name and through VBA pull all the row data associated to them, the info is contained in 3 different Sheets and containing different information but 1 single similarity, the name. Once Data is gather I need for it to display the total/average of the pulled data. This is what I have so far, but it takes more than 30 seconds and it doesn't allow me to add totals

I set already my variables and set each worksheet

Sub siplifydata()

'Declare values
Dim iphws As Worksheet 
Dim dataws As Worksheet 
Dim ivfnws As Worksheet
Dim ivfpws As Worksheet
Dim agntlg As String
Dim finalrow As Integer 'last row of data

Dim i As Integer 'row counter

'Set values
Set iphws = Sheet1
Set ivfnws = Sheet2
Set ivfpws = Sheet3
Set dataws = Sheet4
agntlg = dataws.Range("F1").Value
    For i = 2 To finalrow
     If Cells(i, 1) = agntlg Then 'Matches login  to name search
     Range(Cells(i, 1), Cells(i, 6)).Copy 'copies columns
     dataws.Select ' go to report sheet
     Range("A50").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues 'finds first blank
     iphws.Select ' goes back to continue search
    End If

    Next i
    dataws.Select
    ivfnws.Select

    For i = 2 To finalrow
     If Cells(i, 1) = agntlg Then 'Matches login  to name search
     Range(Cells(i, 1), Cells(i, 6)).Copy 'copies columns
     dataws.Select ' go to report sheet
     Range("H50").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues 'finds first blank
     ivfnws.Select ' goes back to continue search
    End If

    Next i
    dataws.Select


    ivfpws.Select

    For i = 2 To finalrow
     If Cells(i, 1) = agntlg Then 'Matches login  to name search
     Range(Cells(i, 1), Cells(i, 6)).Copy 'copies columns
     dataws.Select ' go to report sheet
     Range("O50").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues 'finds first blank
     ivfpws.Select ' goes back to continue search
    End If

    Next i
    dataws.Select

Tim Williams · Accepted Answer · 2021-03-13T04:31:59.303

1

Factoring out the common parts and using direct value assignment instead of copy-activate-paste-activate

FYI you would find this post and the related info very helpful if you want to write robust VBA in Excel:

How to avoid using Select in Excel VBA

EDIT: fixed and tested...

Sub Tester()
    
    Dim agntlg
    '....
    agntlg = "this"
    
    FetchRowsAndSummarize agntlg, iphws, dataws.Range("A50")
    FetchRowsAndSummarize agntlg, ivfnws, dataws.Range("H50")
    FetchRowsAndSummarize agntlg, ivfpws, dataws.Range("O50")
    
    dataws.Select

End Sub

Sub FetchRowsAndSummarize(vSearch, wsSearch As Worksheet, rngDest As Range)
    Const COPY_COLS As Long = 6
    Dim c As Range, cDest As Range, rw As Long, rngCalc As Range, v, colNum As Long
    
    Set cDest = rngDest.End(xlUp).Offset(1, 0) 'start point for copied data
    rw = cDest.Row                             'row of data start point
    For Each c In wsSearch.Range("A2:A" & wsSearch.Cells(Rows.Count, 1).End(xlUp).Row).Cells
        If c.Value = vSearch Then
            cDest.Resize(1, COPY_COLS).Value = c.Resize(1, COPY_COLS).Value
            Set cDest = cDest.Offset(1, 0) 'next row
        End If
    Next c
    
    'insert summary formula(s) - loop over column numbers (of copied data) to summarize
    For Each v In Array(2, 3, 4, 5, 6)
        colNum = cDest.Offset(0, v - 1).Column
        Set rngCalc = wsSearch.Range(wsSearch.Cells(rw, colNum), wsSearch.Cells(cDest.Row - 1, colNum))
        With cDest.Offset(0, v - 1)
            .Formula = "=AVERAGE(" & rngCalc.Address(False, False) & ")"
            .Font.Bold = True
        End With
    Next v
    
End Sub

edited Mar 13 '21 at 04:31

answered Mar 12 '21 at 18:57

Tim Williams

154,628
8
97
125

this is the begining code,the one provided its working properly, now how i can set for example iphws to paste info in a range starting at A6, ivfnws in h9 and ivfpws in o9, – Richard Fowler Mar 12 '21 at 19:18
If you want to add code, edit your question and add it there. – Tim Williams Mar 12 '21 at 19:19
Thanks alot the answer help alot!, Quicck question, in the end of the row how i will be able to auto add total or average of the displayed data? – Richard Fowler Mar 12 '21 at 19:30
What should be included in the sum/average: just the copied data, or is there already existing data on the destination sheet? – Tim Williams Mar 12 '21 at 19:53
The copied Data Eg (what the code pulls) agent 1 metric 1 agent 1 metric 2 agent 1 metric 3 after data is pulled do this: agent 1 average of metric 1,2,3 – Richard Fowler Mar 12 '21 at 20:01
for 'insert summary formula(s) i just need to add for example =average B6:B29, =sum C6:c29... and so on? for each range i want to total? – Richard Fowler Mar 12 '21 at 20:36
Yeah I forgot we're not totaling the first column... Give me a few minutes. – Tim Williams Mar 12 '21 at 21:19

VBA, Auto filter and copy large amount of data

1 Answers1