Using VBA code instead of 'if' and 'vlookup'

[emily1800]

Hi,
I am working on this data sheet which has almost 2 million values stored. I need to find the values above 250 and the prospective date and values to a new tab. I really don't want to use the 'if' and 'vlookup' formula and drag it forever. Additionally I am supposed to not have any zero values or empty rows. I would really appreciate any help writing a VBA code for this task. I have a very fundamental knowledge about it, so please disregard my ignorance.
I am attaching this sample file, so that it makes more sense.

Thanks a lot!

ExampleSheet.xlsx

[Jim Cone]

I used your example file. If it actually represents your data then...

sort by the values column
all of the values >= to 250 are adjacent
copy and paste the rows to the other sheet.

In the example file the desired data is in the last 33 rows.

'---
Jim Cone
Portland, Oregon USA
https://goo.gl/IUQUN2" onclick="window.open(this.href);return false; (Dropbox)

[emily1800]

Thanks Jim,

My network won't let me go to the file sharing site for security reason. Would you mind uploading the file here?

[emily1800]

Oh now I see what you are saying. But as I was saying the file I uploaded is just a sample. The number goes down to 2 million. Again I am not going to be able to copy and paste even half of that.

[Rudi]

Hi Emily,

Welcome to Eileen's Lounge.

You say that you have almost 2 million records, but Excel has a maximum of 1,048,576 rows.
Can you clarify if the data in question is in Excel or in another format?

[HansV]

Welcome to Eileen's Lounge!
Here is a macro:

Code: Select all

Sub CopyData()
    Dim wsh1 As Worksheet
    Dim wsh2 As Worksheet
    Set wsh1 = Worksheets("Actual Example Data")
    Set wsh2 = Worksheets(">250")
    Application.ScreenUpdating = False
    With wsh1.UsedRange
        .AutoFilter Field:=2, Criteria1:=">250"
        .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1).Copy Destination:=wsh2.Range("A2")
        .AutoFilter
    End With
    Application.ScreenUpdating = True
End Sub

[emily1800]

Hi Emily,

Welcome to Eileen's Lounge.

You say that you have almost 2 million records, but Excel has a maximum of 1,048,576 rows.
Can you clarify if the data in question is in Excel or in another format?

Hi Rudy,

It's actually two different tabs.

[emily1800]

Welcome to Eileen's Lounge!
Here is a macro:

Code: Select all

Sub CopyData()
    Dim wsh1 As Worksheet
    Dim wsh2 As Worksheet
    Set wsh1 = Worksheets("Actual Example Data")
    Set wsh2 = Worksheets(">250")
    Application.ScreenUpdating = False
    With wsh1.UsedRange
        .AutoFilter Field:=2, Criteria1:=">250"
        .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1).Copy Destination:=wsh2.Range("A2")
        .AutoFilter
    End With
    Application.ScreenUpdating = True
End Sub

Thanks Hans, This was exactly what I needed. You are a savior.

[Rudi]

Here is another version I started working on...
Thought I'd just post it anyways.

Code: Select all

Sub GetData()
Dim shSource As Worksheet
Dim shDest As Worksheet
Dim rgT As Range, rgC As Range
    Set shSource = Worksheets("Actual Example Data")
    Set shDest = Worksheets(">250")
    Application.ScreenUpdating = False
    shSource.Range("A1").CurrentRegion.Sort _
        Key1:=shSource.Range("B1"), Order1:=xlDescending, Header:=xlYes
    For Each rgC In shSource.Range("A1").CurrentRegion.Columns("B").Cells
        If rgC.Value < 250 Then
            Set rgT = rgC
            Exit For
        End If
    Next rgC
    shDest.Range("A1", "C" & rgT.Row - 1).Value = shSource.Range("A1", "C" & rgT.Row - 1).Value
    shDest.Columns.AutoFit
    Application.ScreenUpdating = True
End Sub

Note: That both my and Hans's code will need to be modified to run on the second sheet of data...

[emily1800]

Rudi,

This one works perfectly too. You guys are awesome!!

Thanks a ton.