Searching and copying

[gacid]

Hi!

I have at workbook with 2 worksheets; one named ?Members? another named ?Results?.
The worksheet ?Members? are filled with data, and the columns looks like this:
Col A : First name
Col B : Last name
Col C : Address
Col D : Zip code
Col E : City
Col F : Country
Col G : E-mail
Col H : Uniq number
Col I : Age

I have to criterions who have to be true:
1) I only want people who have a zip code between 5000 and 5270 (both inclusive)
2) I only want people who have an age between 30 and 35 (both inclusive)


Now I want Excel to search ?Col D? for zip codes between 5000 and 5270
Afterwards ? ONLY among the people who have a zip code between 5000 and 5270 ? I want Excel to search ?Col I? for ages between 30 and 35.

The persons who satisfy BOTH two criterions should now be copied to worksheet ?Results? with their: (Col A)First name, (Col B)Last name, (Col C) Address (Col D)Zip code, (Col E)City and (Col I)Age
Can anyone out there help?

In advance; thanks a lot!

[fb7894]

Here is some VBA code that should work. It will insert a formula in Column J. If your conditions are met, it will insert the word "copy". It then copies each row that contains the word copy to sheet 2. Hope this helps.

[vba]
With Sheet1.Range("J1:J" & Sheet1.UsedRange.Rows.Count)
.Formula = "=IF(AND((AND(D2 <= 5270,D2 >=5000),AND(I2<=35,I2>=30)),""COPY"","""")"
.Value = .Value
On Error Resume Next
.SpecialCells(xlCellTypeConstants).EntireRow.Copy Destination:=Sheet2.Range("A1")
End With
On Error GoTo 0[/vba]

[Demosthine]

Good Evening.

Depending on the size of your source data, you may not want to modify any cells by adding a formula. If you have large amount of data, each formula is recalculated any time a cell formula or value changes and can drastically degrade performance. For small amounts of data, rather than having the Macro write the formula, you could even manage that manually as you input data. That's a sweet little Macro.

For large amounts of data, however, I'd recommend checking the necessary column data inside of the Macro itself. It is slightly more code, however.

[VBA]
With ActiveSheet
For intRow = 2 To .UsedRange.End(xlDown).Row
If (.Cells(intRow, "D").Value >= intZipLow And _
.Cells(intRow, "D").Value <= intZipHigh) And _
(.Cells(intRow, "I").Value >= intAgeLow And _
.Cells(intRow, "I").Value <= intAgeHigh) Then
.Rows(intRow).Copy Worksheets("Sheet2").Range("A" & Worksheets("Sheet2").UsedRange.Rows + 1)
End If
Next intRow
End With
[/VBA]

Good luck.
Scott

[gacid]

Hi again.
Thank you for the answers

fb7894: VBA shows runtime error '424' (Object required)
This line become yellow when I debug;

With Sheet1.Range("J1:J" & Sheet1.UsedRange.Rows.Count)

I'm a little lost here .. Demosthine's VBA code is running without any error, nothing is happening.

Any suggestions?

Btw. I have at middle/large amounts of data; 1254 rows

[david000]

[VBA]Sub GetData()
Dim Source As Worksheet
Dim Dest As Worksheet

Set Source = Worksheets("Members")
Set Dest = Worksheets("Results")

With Source
With .Range("A1") 'header row
.AutoFilter _
Field:=4, _
Criteria1:=">=5000", _
Operator:=xlAnd, _
Criteria2:="<=5270"
.AutoFilter _
Field:=9, _
Criteria1:=">=30", _
Operator:=xlAnd, Criteria2:="<=35"
End With
.UsedRange.SpecialCells(xlCellTypeVisible).Copy Dest.Range("a1")
.Range("a1").AutoFilter
End With

With Dest
.Columns("F:H").Delete
.Columns("A:F").AutoFit
End With
End Sub
[/VBA]

[gacid]

Thanks! But still cant get i work.

Trying to explain myself in another way:

Hi all

I have been given a workbook with information on members from a Gym. On 1 worksheet there is a lot of data (names, addresses, age,***) and I now need to sort specific data from it and copy this data to a second worksheet. The second worksheet needs to be a list of members with following characteristica.

1)Certain Postcode or zip code range (5000-5270)
2)Certain age (30-35)
3) And *** has to be male.

Each Data type is in its own column:
Col A : First name
Col B : Last name
Col C : Address
Col D : Zip code / Postcode = Range from (1000-8000)
Col E : City
Col F : Country
Col G : E-mail
Col H : Social Security numbers
Col I : Age = Range from (0-100)


*** is based on the last 4 digits in the Social security number (160235-4787)
If they are even then = female if odd then = male.

The data in the rows which has to be copied to the second worksheet:
Col A + B + C + D + I

[georgiboy]

Try this, sorry if its a bit simple i am not the best in VBA

[VBA]Sub Weeder()

Dim Myrange As Range, rCell As Range, Ender As Integer
x = 1
Ender = WorksheetFunction.CountA(Sheets("Members").Range("A:A"))

Set Myrange = Sheets("Members").Range("A1:A" & Ender)

For Each rCell In Myrange.Cells

If rCell.Offset(, 3).Value >= 5000 Then
If rCell.Offset(, 3).Value <= 5270 Then
If rCell.Offset(, 8).Value >= 30 Then
If rCell.Offset(, 8).Value <= 35 Then
x = x + 1
Range(rCell, rCell.Offset(, 4)).Copy Sheets("Results").Range("A" & x)
rCell.Offset(, 8).Copy Sheets("Results").Range("F" & x)

End If
End If
End If
End If

Next rCell

End Sub[/VBA]

hope this helps

[gacid]

Thank you! That helped! Really great

What can I do if I want Col A+B from (worksheet1) 'Members' to be both pasted in Col A in (worksheet2) 'Results' ? And furthermore Col C in worksheet1 to be pasted in Col B worksheet2. And Col D in worksheet1 to be pasted in Col C in worksheet2 ... and so on ..

Last question:
Sex is based on the last 4 digits in the Social security number (Col H) (ex. 160235-4787)
If they are even then = female if odd then = male.

I have to create an input box to choose between male/female members.
->
Then after the input.

If Male: Then VBA has to choose Odd numbers in column H and use this in the criteria when copying to sheet 2

If Female: VBA has to choose Even numbers from column H as criteria when copying to sheet 2.

Thanks again.

[georgiboy]

You mean like this

[VBA]Sub Selector()

i = InputBox("Please type Male or Female", "Input required", "Male")

If WorksheetFunction.Proper(i) = "Male" Then Call Weeder_Male

If WorksheetFunction.Proper(i) = "Female" Then Call Weeder_Female

End Sub



Sub Weeder_Male()

Dim Myrange As Range, rCell As Range, Ender As Integer
x = 1
Ender = WorksheetFunction.CountA(Sheets("Members").Range("A:A"))

Set Myrange = Sheets("Members").Range("A1:A" & Ender)

For Each rCell In Myrange.Cells

If rCell.Offset(, 3).Value >= 5000 Then
If rCell.Offset(, 3).Value <= 5270 Then
If rCell.Offset(, 8).Value >= 30 Then
If rCell.Offset(, 8).Value <= 35 Then

If WorksheetFunction.IsOdd(Right(rCell.Offset(, 7), 4)) Then


x = x + 1

Sheets("Results").Range("A" & x) = rCell.Value & " " & rCell.Offset(, 1).Value
Sheets("Results").Range("B" & x) = rCell.Offset(, 2).Value
Sheets("Results").Range("C" & x) = rCell.Offset(, 3).Value
Sheets("Results").Range("D" & x) = rCell.Offset(, 4).Value
Sheets("Results").Range("E" & x) = rCell.Offset(, 8).Value

End If
End If
End If
End If
End If

Next rCell

End Sub


Sub Weeder_Female()

Dim Myrange As Range, rCell As Range, Ender As Integer
x = 1
Ender = WorksheetFunction.CountA(Sheets("Members").Range("A:A"))

Set Myrange = Sheets("Members").Range("A1:A" & Ender)

For Each rCell In Myrange.Cells

If rCell.Offset(, 3).Value >= 5000 Then
If rCell.Offset(, 3).Value <= 5270 Then
If rCell.Offset(, 8).Value >= 30 Then
If rCell.Offset(, 8).Value <= 35 Then

If WorksheetFunction.IsEven(Right(rCell.Offset(, 7), 4)) Then


x = x + 1

Sheets("Results").Range("A" & x) = rCell.Value & " " & rCell.Offset(, 1).Value
Sheets("Results").Range("B" & x) = rCell.Offset(, 2).Value
Sheets("Results").Range("C" & x) = rCell.Offset(, 3).Value
Sheets("Results").Range("D" & x) = rCell.Offset(, 4).Value
Sheets("Results").Range("E" & x) = rCell.Offset(, 8).Value

End If
End If
End If
End If
End If

Next rCell

End Sub[/VBA]

hope this helps

[gacid]

FANTASTIC!!! I works perfect!

Last question now, I promise
Can you tell me what code is doing - just shortly. If you juse ' you can make af small comment on the most important lines

Regards

THANKS

[georgiboy]

[VBA]Sub Selector()
'input box to select male or female
i = InputBox("Please type Male or Female", "Input required", "Male")

' the proper function will capitalize anything inputted to avoid user input error
' then it will call the apropriate macro as below
If WorksheetFunction.Proper(i) = "Male" Then Call Weeder_Male

If WorksheetFunction.Proper(i) = "Female" Then Call Weeder_Female

End Sub



Sub Weeder_Male()

Dim Myrange As Range, rCell As Range, Ender As Integer
x = 1 ' this will set the copy to range, i will then add one later to miss the header

' this will make Ender the total rows on the sheet so as not to miss any data
Ender = WorksheetFunction.CountA(Sheets("Members").Range("A:A"))

' this is setting the range to the first column from top to bottom using Ender
' which we defined earlier by countin the data in column "A"
Set Myrange = Sheets("Members").Range("A1:A" & Ender)

' now to loop through the cells defined above on sheet main using your criteria
' using a for next loop
For Each rCell In Myrange.Cells

' your givemn criteria usin if then statements, if any of them are false then it will
' ignore them
If rCell.Offset(, 3).Value >= 5000 Then
If rCell.Offset(, 3).Value <= 5270 Then
If rCell.Offset(, 8).Value >= 30 Then
If rCell.Offset(, 8).Value <= 35 Then

' this bit defines if the last 4 digits of the unique number are Odd
' or in the female macro Even, that is the only difference between the two macros (Male/Female)
If WorksheetFunction.IsOdd(Right(rCell.Offset(, 7), 4)) Then

' adding 1 to x will make it miss the header on the copy to sheet and start at 2
x = x + 1

' this is the bit that is making the result sheet range value equel the cells found
' by the given criteria searching the Members sheet
Sheets("Results").Range("A" & x) = rCell.Value & " " & rCell.Offset(, 1).Value
Sheets("Results").Range("B" & x) = rCell.Offset(, 2).Value
Sheets("Results").Range("C" & x) = rCell.Offset(, 3).Value
Sheets("Results").Range("D" & x) = rCell.Offset(, 4).Value
Sheets("Results").Range("E" & x) = rCell.Offset(, 8).Value

' closing all the above if statements in one go
End If
End If
End If
End If
End If

' this makes it start again from the beginning of the loop, the For Each bit
Next rCell

End Sub


Sub Weeder_Female()

Dim Myrange As Range, rCell As Range, Ender As Integer
x = 1
Ender = WorksheetFunction.CountA(Sheets("Members").Range("A:A"))

Set Myrange = Sheets("Members").Range("A1:A" & Ender)

For Each rCell In Myrange.Cells

If rCell.Offset(, 3).Value >= 5000 Then
If rCell.Offset(, 3).Value <= 5270 Then
If rCell.Offset(, 8).Value >= 30 Then
If rCell.Offset(, 8).Value <= 35 Then

If WorksheetFunction.IsEven(Right(rCell.Offset(, 7), 4)) Then


x = x + 1

Sheets("Results").Range("A" & x) = rCell.Value & " " & rCell.Offset(, 1).Value
Sheets("Results").Range("B" & x) = rCell.Offset(, 2).Value
Sheets("Results").Range("C" & x) = rCell.Offset(, 3).Value
Sheets("Results").Range("D" & x) = rCell.Offset(, 4).Value
Sheets("Results").Range("E" & x) = rCell.Offset(, 8).Value

End If
End If
End If
End If
End If

Next rCell

End Sub[/VBA]

hope this helps you understand, be brave and play!