Needed help in running the macro very urgent

kausikmohan

New member
Joined
Sep 26, 2018
Messages
1
Reaction score
0
Points
0
Excel Version(s)
2016
Hi Folks,

I am new here, 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.

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
 
Hi
as this a a free forum you cannot expect people to answer your request instantly.
If it is very urgent you might try pay sites.
 
Back
Top