VBA: Copy and Paste value to new sheet based on criteria from other columns

[jhsu0303]

I have a data set that has Farmer name in column A, Fruit in column B and Ready? in column C. I want to copy and paste the farmer's name based on the fruit they plant onto their designated sheet (for example, APPLE under the sheet named APPLE), but I only want they want has yea under the Ready? column.

I was wondering if anyone tell me what is the best way to do this in VBA that creates the new sheet and copy and paste the criteria that I described above.

I am very new to VBA and writing this on my own is total out of my league.

Farmer	Fruit	Ready?
A	APPLE	YES
C	APPLE	NO
G	APPLE	YES
E	GRAPES	YES
B	ORANGE	YES
F	ORANGE	NO
D	PEARS	NO
H	PEARS	YES

<colgroup><col width="64" span="3" style="width:48pt"> </colgroup><tbody>
</tbody>

 

[farmerscott]

1. will there be only 'apple', 'grapes', 'orange' and 'pears' or other fruit?
2. do these sheets already exist or do they need to be created by the code?
Do you want the headers in the new sheets?

FarmerScott

 

[jhsu0303]

Yes, there will be other fruits.

preferably I would like to create new sheet based on the fruit category, so it know when there is a new fruit and a new sheet needs to be created.

 

[farmerscott]

does the existing sheet (with the data) have a name???

 

[jhsu0303]

The sheet is named "Data"

 

[farmerscott]

Hi,

can you test this code to see if a sheet is created for each fruit.

I will add more code for the copying, once we get this right.

I have assumed that the list of fruits is in Col B as per your post above.

Sub New_sheet_for_each_fruit()
Dim Rng As Range
Dim cell As Range
Dim sh As Worksheet

Dim sheetname As String


lr = Worksheets("Data").Range("B" & Rows.Count).End(xlUp).Row

Set Rng = Worksheets("Data").Range("B1:B" & lr)

'loop through range with fruit names
For Each cell In Rng

If cell.Value <> "" Then
sheetname = cell.Value

'test if the cell value has an equivalent sheet name
If Not SheetExists(sheetname) Then



Sheets.Add.Name = sheetname
End If
End If
Next
End Sub



Function SheetExists(sheetname As String) As Boolean
SheetExists = False
For Each sh In Sheets
If sh.Name = sheetname Then
SheetExists = True
Exit For
End If
Next sh
End Function

FarmerScott