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
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.