Macro to find a range that varies.

[Guest]

Hi,
I want to write a macro that finds a range between two "find" terms, so I
can cut it from a sheet and post into another sheet.

So, I first want to find "Reconciliations" in column D. Then find "Account
Balance"in column D. I then want to cut the rows between these two rows and
paste into another sheet. I will then run the macro again to find the next
occurences. So, the first time "Reconciliations" might be in row 50 and
"Account Balance" in row 60, so I cut rows 50 to 60. Next time
"Reconciliations" is in row 100 and "Account Balance" in row 145, so I cut
rows 100 to 145.

Below is the macro I want to modify, so any help would be greatly appreciated.

Thanks for looking

Paul

Sub Pastedetails()


'
' Cutpaste Macro
' Macro recorded 22/11/2005 by IT Services
'
' Keyboard Shortcut: Ctrl+x
Dim rngFound As Range
Dim sStart As String
Dim sDestRange As String

Sheets("Posting").Activate
sStart = "D1"
sDestRange = "D1"

Range(sStart).Select

Set rngFound = Cells.Find(What:="Reconciliations", After:=ActiveCell,
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns,
SearchDirection:=xlNext)

I think this is where I would have to modify the macro to find "Account
Balance" and set the range to be cut.


Do While Not rngFound Is Nothing

If Not rngFound Is Nothing Then
Range(rngFound.Offset(0, 0).Address, rngFound.Offset(13,
0).Address).EntireRow.Cut

Sheets("Summary").Activate
ActiveCell.SpecialCells (xlCellTypeLastCell)


ActiveSheet.Paste

sDestRange = Range(sDestRange).End(xlDown).Offset(1, 0).Address

Cells.Select
Cells.EntireColumn.AutoFit

Sheet1.Activate
End If

Range(rngFound.Offset(1, 0).Address).Activate

Set rngFound = Cells.FindNext(After:=ActiveCell)


Windows("Control1.xls").Activate
ActiveCell.SpecialCells(xlCellTypeLastCell).Offset(1, -5).Select


Loop
End Sub

 

[Don Guillett]

this should be a bit easier.

Sub findrange()
x = Columns(4).Find("rec").Row
y = Columns(4).Find("acc").Row
z = Sheets("sheet2").Cells(Rows.Count, "a").End(xlUp).Row + 1
Rows(x & ":" & y).Cut Sheets("sheet2").Range("a" & z)
End Sub

 

[Bob Phillips]

Try this, untested I am afraid

Sub Pastedetails()
Dim rng1 As Range
Dim rng2 As Range
Dim rngTarget As Range

Sheets("Posting").Activate
Set rng2 = Range("A1")
Do
Set rng1 = Nothing
Set rng1 = Cells.Find(What:="Reconciliations", _
After:=rng2, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext)
If Not rng1 Is Nothing Then
Set rng2 = Nothing
Set rng2 = Cells.Find(What:="Account Balance", _
After:=rng1, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext)
If Not rng2 Is Nothing Then
Set rngTarget = Sheets("Summary").Range("A1") _
.SpecialCells(xlCellTypeLastCell)
Range(rng1, rng2).Copy rngTarget.Offset(1, 0)
Range(rng1, rng2).Clear
End If
End If
Loop Until rng1 Is Nothing

End Sub




--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)

 

[Don Guillett]

another way would be to define a name using offset with match to find the
rec & acc and then just use that defined name.

 

[Guest]

Fantastic, that's really useful. Much appreciated.

I've got the following code working fine, I just run the macro until it runs
out of data to find. The only problem is that when there is no more data to
find the macro ends as an error. Is there any way of ending the macro
"cleanly"when there are no more entries?

Thanks again for the help.

Paul
Sub Pastedetails()

' Cutpaste Macro
' Macro recorded 22/11/2005 by IT Services
'
' Keyboard Shortcut: Ctrl+x

Sheets("Posting").Activate

x = Columns(3).Find("Reconciliations - Outstanding Items").Row
y = Columns(3).Find("Account Balance - Per master File").Row
z = Sheets("Posting").Cells(Rows.Count, "a").End(xlUp).Row + 1
Rows(x & ":" & y).Cut

Sheets("Summary").Activate
ActiveCell.SpecialCells (xlCellTypeLastCell)

ActiveSheet.Paste

Cells.Select
Cells.EntireColumn.AutoFit

Windows("Suspense1.xls").Activate
ActiveCell.SpecialCells(xlCellTypeLastCell).Offset(1, -5).Select

End Sub