Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Conditional Search & Cut and Paste *VBA?
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Search, Copy & Paste Formula | Excel Discussion (Misc queries) | |||
Search, cut & paste | Excel Worksheet Functions | |||
Search, copy and paste help | Excel Discussion (Misc queries) | |||
VBA-code for search,copy and paste | Excel Discussion (Misc queries) | |||
search/copy/paste macro | Excel Programming |