looping macros

[Bradly]

I am creating an Excel spreadsheet called "Bartow550" which lists all clients
at or above an allotment level of 550. In conjunction with this, I have
imported an allotment report into Excel and I call this spreadsheet
"BartowAllotments". I have figured out a macro to find the first client who
has an allotment level of 550, copy that client's information, and paste it
into the "Bartow550" report. Below is my macro:

Sub GetBartow550()
'
' GetBartow550 Macro
' Macro recorded 7/9/2009 by dhruser
'

'
Windows("BartowAllotments.xls").Activate
Range("A1").Select
Cells.Find(What:="550", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
Selection.Offset(0, -4).Range("A1:F1").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Bartow550.xls").Activate
Range("A1").Select
ActiveCell.Offset(rowOffset:=2, columnOffset:=0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False


End Sub

The problem is that there are several clients who are at or above the 550
allotment level, and I want to paste all of those clients and their
information into the "Bartow550" report.

How do I loop through the macro to find the next client and paste the
information in my "Bartow550" spreadsheet? I have looked up Help entries for
the Do...Loop and the For...Next loops, but I can't find any examples that I
can understand (I am a beginner using macros).

Thanks.

 

[ryguy7272]

I don't think you have to loop to do this. Try the code below:
Sub Macro2()

Range("A1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:=">=550", Operator:=xlAnd
Columns("A:Z").Select
Selection.Copy
Sheets("Bartow550").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
End Sub

HTH,
Ryan--

 

[Per Jessen]

Hi

I assume the macro are supposed to search column E for the value, and we are
working with sheet1 in both workbooks. If not change in macros as requierd.
Try this:

Sub GetBartow550()
'
' GetBartow550 Macro
'
Dim wbA As Workbook
Dim wbB As Workbook
Dim TargetSh As Worksheet
Dim DestSh As Worksheet
Dim SearchRange As Range
Dim DestCell As Range

Set wbA = Workbooks("BartowAllotments.xls")
Set wbB = Windows("Bartow550.xls")
Set TargetSh = wbA.Worksheets("Sheet1")

Set SearchRange = TargetSh.Range("E1", TargetSh.Range _
("E" & Rows.Count).End(xlUp))

Set f = SearchRange.Find(What:="550", After:=TargetSh.Range _
("E1"), LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If f Is Nothing Then
msg = MsgBox("No clients found!")
Exit Sub
End If
Set FirstFound = f
Set DestCell = wbB.Worksheets("Sheet1").Range("A3")
Do
f.Offset(0, -4).Range("A1:F1").Copy
DestCell.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Set DestCell = DestCell.Offset(1, 0)
SearchRange.FindNext
Loop Until f.Address = FirstFound.Address
End Sub

Hopes this helps.
....
Per

 

[LOFE]

There are a couple of variables to determine but from a beginner perspective,
try something like this:

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Windows("BartowAllotments.xls").Activate
Range("A1").Select
Windows("BartowAllotments.xls").Activate
Range("A1").Select

Do Until Activecell = "" 'Assuming there is data in all cells in Column A
If Activecell(1,5) = "550" Then 'This is saying that 550 appears in
Column E of the same row
Activecell.EntireRow.Copy
Windows("Bartow 550.xls").Activate
Activesheet.Paste
Activecell(2,1).Select
Windows("BartowAllotments.xls").Activate
Application.CutCopyMode = False
End If
Activecell(2,1).Select
Loop

Application.ScreenUpdating = True
Application.DisplayAlerts = True

The ScreenUpdating and DisplayAlerts just makes it run much quicker.