Hi Folks, Needed a very urgent help.
I have developed a macro where it pulls the data from WorkBook 2 based on Criteria in Workbook 1. Macro is running fine but it takes more time to populate the data for me since the Workbook 2 *SERP DATA DUMP" is a 61 MB file.
Can someone help me ASAP? as I need to present this one in tomorrow's meeting.
Thanks in advance.
I have developed a macro where it pulls the data from WorkBook 2 based on Criteria in Workbook 1. Macro is running fine but it takes more time to populate the data for me since the Workbook 2 *SERP DATA DUMP" is a 61 MB file.
Can someone help me ASAP? as I need to present this one in tomorrow's meeting.
Thanks in advance.
Code:
Sub Filter&Paste()
Dim wsData As Worksheet
Dim wsMacro As Worksheet
Dim sToFind As String
Dim sFirstAddress As String
Dim nr As Long, lr As Long
Dim rFind As Range
Set wsData = Workbooks("SERP Data Dump.xlsm").Sheets("Data")
Set wsMacro = Workbooks("Preliminary SERP SOA template.xlsm").Sheets("FBL Data")
lr = wsData.Range("F" & Rows.Count).End(xlUp).Row
sToFind = wsMacro.Range("A1").Value
nr = wsMacro.Range("A" & Rows.Count).End(xlUp).Row + 1
Set rFind = wsData.Range("F1:F" & lr).Find(What:=sToFind)
If rFind Is Nothing Then
MsgBox sToFind & " could not be found in Column F", vbInformation, "Not Found"
Exit Sub
End If
sFirstAddress = rFind.Address
Do
rFind.EntireRow.Copy
wsMacro.Range("A" & nr).PasteSpecial xlPasteAll
nr = nr + 1
Set rFind = wsData.Range("F1:F" & lr).FindNext(After:=rFind)
Loop Until rFind.Address = sFirstAddress
Set rFind = Nothing
Set wsData = Nothing
Set wsMacro = Nothing
Rows("3:3").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A3").Select
End Sub
Last edited by a moderator:
it worked John. Thank you so much