Copy Data from table based on Criteria

[Smartkid]

I am trying to create a macro (my very first one) that will look at a table from Sheet1 and populate Sheet2 based on user defined criteria.

For example:
If in Sheet 1, I have the following table:
Jan Feb Mar
Vegetables
Asparagus 2 3 4
Carrot 5 5 5
Celery 2 8 6
<Blank>
Fruit
Apple 5 3 2
Pear 2 3 5
Banana 2 1 1
Kiwi 9 7 6

On Sheet 2, for whatever is inputed in Cell A1 (Vegetable OR Fruit) and Cell B1 (Month),
I want the macro to populate cells A2:Bx based on what was in the table from Sheet 1.

So if on Sheet 2, the following was input: Vegetable Feb
The macrec would produce the following
Asparagus 3
Carrot 5
Celery 8

My problem is more complicated than this simple example, but I think if someone can help me with this part, I will be able to figure out how to go about doing the rest.

Any help would be greatly appreciated.

Many thanks

[Bob Phillips]

[vba]

Public Sub ProcessData()
Dim LastRow As Long
Dim NextRow As Long
Dim MonthCol As Long
Dim i As Long
Dim Target As Worksheet

Set Target = Worksheets("Sheet2")
Target.Range(Target.Range("A2"), Target.Range("B2").End(xlDown)).ClearContents
With Worksheets("Sheet1")

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
On Error Resume Next
MonthCol = Application.Match(Target.Range("B1").Value, .Rows(1), 0)
On Error GoTo 0
If MonthCol > 1 Then

i = 1
Do While i <= LastRow And .Cells(i, "A").Value <> Target.Range("A1").Value

i = i + 1
Loop
If i <= LastRow Then

i = i + 1
NextRow = 1
Do While i <= LastRow And .Cells(i, "A").Value <> ""

NextRow = NextRow + 1
.Cells(i, "A").Copy Target.Cells(NextRow, "A")
.Cells(i, MonthCol).Copy Target.Cells(NextRow, "B")
i = i + 1
Loop
End If
End If
End With
End Sub
[/vba]

[Smartkid]

Wow thanks for the prompt response.

I will work with it as my foundation and let you know if I have further questions.

Thanks again!

[Smartkid]

I've been working on building off of the code above.

For this line:
.Cells(i, "A").Copy Target.Cells(NextRow, "A")

I run into a problem when the cell from Sheet 1 contains a formula. It copies over the formula and the therefore, the value displayed on Sheet 2 changes.

What's the best way to amend the line? I want to still be able to copy over all the formatting/comments from the cells in Sheet 1 but not the formulas.

Thanks

[Bob Phillips]

[vba]

Public Sub ProcessData()
Dim LastRow As Long
Dim NextRow As Long
Dim MonthCol As Long
Dim i As Long
Dim Target As Worksheet

Application.Calculation = xlCalculationManual
Set Target = Worksheets("Sheet2")
Target.Range(Target.Range("A2"), Target.Range("B2").End(xlDown)).ClearContents
With Worksheets("Sheet1")

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
On Error Resume Next
MonthCol = Application.Match(Target.Range("B1").Value, .Rows(1), 0)
On Error GoTo 0
If MonthCol > 1 Then

i = 1
Do While i <= LastRow And .Cells(i, "A").Value <> Target.Range("A1").Value

i = i + 1
Loop
If i <= LastRow Then

i = i + 1
NextRow = 1
Do While i <= LastRow And .Cells(i, "A").Value <> ""

NextRow = NextRow + 1
.Cells(i, "A").Copy Target.Cells(NextRow, "A")
.Cells(i, MonthCol).Copy Target.Cells(NextRow, "B")
Target.Cells(NextRow, "B").Value = Target.Cells(NextRow, "B").Value
i = i + 1
Loop
End If
End If
End With
Application.Calculation = xlCalculationAutomatic
End Sub
[/vba]

[Smartkid]

That was a relatively simple fix!

and it Works perfectly.

Thanks!