PDA

View Full Version : Value change with date



bobby_793
04-02-2008, 10:42 AM
Helloo

Is there any way that if in one coloum i have more than 2500 numbers and i have put the conditional values that if the value is grater than 500 the cell color should be red. this farmula works fine. Now the matter is red color cell should copy to the next sheet with complete row data.

Is there any way in VBA

Thanks

Bobby

georgiboy
04-02-2008, 11:13 AM
This should do it it you adjust it to your ranges and sheet names
Sub MoveRow()
Sheets("Sheet1").Range("A1").Activate
Do While ActiveCell.Value <> ""
If ActiveCell.Value > 500 Then
ActiveCell.EntireRow.Copy
ActiveCell.Offset(1, 0).Activate
Sheets("Sheet2").Select
Range("A1").Select
Do While ActiveCell.Value <> ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.PasteSpecial xlPasteValuesAndNumberFormats
Sheets("Sheet1").Activate
Else
ActiveCell.Offset(1, 0).Activate
End If
Loop

End Sub

Hope this helps

bobby_793
04-02-2008, 11:25 AM
Thank you georgiboy really its work fine
thank you

mdmackillop
04-03-2008, 05:18 AM
Hi Georgi,
While the loop works, it can be slow for a lot of data. You can speed it up be avoiding selecting as

Option Explicit
Sub MoveRow()
Dim Tgt As Range, cel As Range
Dim i As Long

Application.ScreenUpdating = False

Set Tgt = Sheets(2).Cells(Rows.Count, 1).End(xlUp)
With Sheets(1)
For Each cel In Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
If cel > 500 Then
i = i + 1
cel.EntireRow.Copy
Tgt.Offset(i).PasteSpecial xlAll
End If
Next
End With
Application.ScreenUpdating = True

End Sub


Better still, apply a filter for this sort of procedure. Very much quicker.

Option Explicit
Sub FilterData()
With Sheets(1)
.Columns("A:A").AutoFilter Field:=1, Criteria1:=">500"
.UsedRange.SpecialCells(xlCellTypeVisible).Copy
Sheets(3).Range("A1").PasteSpecial xlAll
.Columns("A:A").AutoFilter
End With
End Sub