Conditional Search & Cut and Paste *VBA?
 

:confused:
Hi There
I am looking to put the following pseudo code into VBA or macro in
excel.
It's been years since I've actually coded anything so your help is
appreciated.

PS Will I get emailed when there is a posting to my question? If not,
please email me at

OK here's what I need

At the click of a button the code will search a worksheet (could be
hundreds of rows deep.

(in OriginalWorkbook)
If cell in column B = "READY" and cell in column D = <Todays Date
Then cut row and paste/add to StorageWorkbook
(in StorageWorkbook) If row is not blank then check next row
else paste row from
OriginalWorkbook)
End If
End If


--
AnMalivoire
------------------------------------------------------------------------
AnMalivoire's Profile: http://www.excelforum.com/member.php...o&userid=24350
View this thread: http://www.excelforum.com/showthread...hreadid=379485

Conditional Search & Cut and Paste *VBA?
 

Backup your workbooks before trying this macro

the StorageWorkbook.xls should be opened for this macro to work


Sub Macro4()
Dim r, init, i, a_workbook As Variant
i = 0
a_workbook = ActiveWorkbook.Name
Columns("B:B").Select 'select column b
Selection.Find(What:="READY", After:=ActiveCell, LookIn:=xlValues,
LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False).Activate 'seaching for READY text
init = ActiveCell.Address
If Range("d" & ActiveCell.Row).Value < Now Then 'checking d value
r = ActiveCell.Row & ":" & ActiveCell.Row
End If
While i = 0
Selection.FindNext(After:=ActiveCell).Activate 'search till the
end
If (ActiveCell.Address < init) Then
If Range("d" & ActiveCell.Row).Value < Now Then
r = r & "," & ActiveCell.Row & ":" & ActiveCell.Row
End If
Else
i = 1
End If
Wend
Range(r).Select 'select the rows which satify the condition
Selection.Copy 'copy
Workbooks("StorageWorkbook").Activate 'activate already opened
storageworkbook
Dim used_range As Range
Dim w_row As Variant
Set used_range = ActiveSheet.UsedRange
temp = Split(used_range.Address, ":")
If (UBound(temp) 0) Then
w_row = Range(temp(1)).Row + 1
Else
w_row = 2
End If
Range("a" & w_row).Select 'select the last row+1
ActiveSheet.Paste 'paste the contents
Workbooks(a_workbook).Activate 'activate the original workbook
Selection.ClearContents 'clear content
End Sub


--
anilsolipuram
------------------------------------------------------------------------
anilsolipuram's Profile: http://www.excelforum.com/member.php...o&userid=16271
View this thread: http://www.excelforum.com/showthread...hreadid=379485