Hi Mike,

Works like a charm

Thank you
Albert

"Mike H" wrote:

Dim C as range
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


"Albert" wrote:

Hi mike,

When I run the code I get a message the "For Each c" is not defined.
Do I
Dim c as integer?

What I am trying to do is list items and orders on a seperate worksheet that
are category is equal to food and the order is 0.

So I should only get a list of these column values on the second sheet.

Thanks
Albert

"Mike H" wrote:

Albert,

Try this. I'm still not entirely sure which 2 cells to copy. It currently
copies the ITEM and ORDER cells from each row for that's incorrect then this
is the bit off code that selecst the cells to copy

If CopyRange Is Nothing Then
Set CopyRange = Union(c.Offset(, 1), c.Offset(, 4))
Else
Set CopyRange = Union(CopyRange, Union(c.Offset(, 1), c.Offset(, 4)))
End If

Simply change the offset values but you must leave the comma there. As you
see i copy the cells 1 & 4 to the right of the cell with FOOD in. you must
change both lines


Sub copyCells()
Dim wb As Workbook
Dim ws As Worksheet
Dim newsh As Worksheet
Dim MyRange As Range
Dim LastRow As Long
Dim CopyRange As Range

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set wb = ThisWorkbook
Set newsh = wb.Worksheets.Add
newsh.Name = "Orders for next month"
newsh.Range("a1") = "Orders for the month"
newsh.Range("a2") = "Item"
newsh.Range("b2") = "Quantity"

LastRow = wb.Worksheets("sheet1").Cells(Cells.Rows.Count, "A").End(xlUp).Row
Set MyRange = wb.Worksheets("sheet1").Range("A1:A" & LastRow)
For Each c In MyRange
If UCase(c.Value) = "FOOD" And c.Offset(, 4) 0 Then
If CopyRange Is Nothing Then
Set CopyRange = Union(c.Offset(, 1), c.Offset(, 4))
Else
Set CopyRange = Union(CopyRange, Union(c.Offset(, 1), c.Offset(, 4)))
End If
End If
Next

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

If Not CopyRange Is Nothing Then
CopyRange.Copy Sheets("Orders for next month").Range("A3")
End If
End Sub

--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


"Albert" wrote:

Hi Mike,

Thanks for the response.

Below is the source table

Category Item Value Quantity Order
Food cereal 12 2 1
Food pet 39 2 0
Garden Outside 78 2 1
Garden Inside 34 2 1

If category = "Food" and order 0 then copy item and order values to new
worksheet for the full source range.

I hope this helps

"Mike H" wrote:

Albert,

It isn't clear what cells in the row you want to copy. have a look at the
code below and in the bit where we find 'Food' tell us what you want copying.

Bear in mind that when using OFFSET the syntax is OFFSET(Row, Column)

Sub copyCells()
' Testsubmit Macro

'Declare variables
Dim wb As Workbook
Dim ws As Worksheet
Dim newsh As Worksheet
Dim MyRange As Range
Dim LastRow As Long


With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set wb = ThisWorkbook
Set newsh = wb.Worksheets.Add
newsh.Name = "Orders for next month"
newsh.Range("a1") = "Orders for the month"
newsh.Range("a2") = "Item"
newsh.Range("b2") = "Quantity"


LastRow = wb.Worksheets("sheet1").Cells(Cells.Rows.Count, "A").End(xlUp).Row
Set MyRange = wb.Worksheets("sheet1").Range("A1:A" & LastRow)


For Each c In MyRange


If c.Offset(, 1) = "Food" Then
'tell us which cells to copy
End If

Next
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


"Albert" wrote:

Hi Guys,

I am trying to create a macro (unsuccessfully) to:
1. Create a new sheet
2. select a range
3. loop through the range until the range is empty
4. check criteria of cells in range
5. if true copy 2of the cells in the row range to the new worksheet
6. loop through range and create a list in the new worksheet

This is what I got so far:
Sub copyCells()
' Testsubmit Macro

'Declare variables
Dim wb As Workbook
Dim wssheet1 As Worksheet
Dim wssheet2 As Worksheet
Dim ws As Worksheet
Dim newsh As Worksheet
Dim DestinationRange As Range
Dim SourceRange As Range

Dim lRow As Integer


Set wb = ThisWorkbook
Set newsh = wb.Worksheets.Add
newsh.Name = "Orders for next month"
newsh.Range("a1") = "Orders for the month"
newsh.Range("a2") = "Item"
newsh.Range("b2") = "Quantity"

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Do Until IsEmpty(SourceRange)
Set SourceRange = wb.Worksheets("sheet1").Range("a1")
If SourceRange.Offset(1, 0) = "Food" And SourceRange.Offset(1, 0)
"0" Then
Set DestinationRange = wb.Worksheets("Orders for the month").Range("a1")
SourceRange.Offset(1, 0) = DestinationRange.Offset(3, 0)
SourceRange.Offset(1, 5) = DestinationRange.Offset(3, 1)

Loop
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

Please help?

Thanks
Albert