About Us

Gareth[_3_]

many thanks.

"J.E. McGimpsey" wrote in message
...
One way:

Replace

If Intersect(rng, .Columns(2)).SpecialCells( _
xlCellTypeVisible).Count 1 Then _
Intersect(rng, .Range("C2:C65532")).Copy _
Destination:=cell.Offset(3, 0)

with

If Intersect(rng, .Columns(2)).SpecialCells( _
xlCellTypeVisible).Count 1 Then
Intersect(rng, .Range("C2:C65532")).Copy _
Destination:=cell.Offset(3, 0)
cell.Offset(1, 0).Value = Application.CountA( _
cell.Offset(3, 0).Resize(65532, 1))
End If

In article ,
"Gareth" wrote:

Thanks very much for this, it does exactly what I want it to. Apologies
if
I didn't explain everything but it would appear you understood my main
aim.

I have forgotten one bit, after the copy and paste onto sheet1 I want to
count the number of records and put it into cell.Offset(1,0)

Hope you can help.

Gareth
"J.E. McGimpsey" wrote in message
...
I don't understand a bit about what you're doing (see below), but
this will cycle A2:G2:

Public Sub CheckDates()
Dim cell As Range
Dim d1Cell As Range
Dim rng As Range

With Worksheets("Sheet2")
Set d1Cell = .Range("D1")
For Each cell In Worksheets("Sheet1").Range("A2:G2")
If Not IsEmpty(cell.Value) Then
d1Cell.Value = cell.Value
.Range("B1").AutoFilter _
field:=4, Criteria1:="=6"
Set rng = .AutoFilter.Range
If Intersect(rng, .Columns(2)).SpecialCells( _
xlCellTypeVisible).Count 1 Then _
Intersect(rng, .Range("C2:C65532")).Copy _
Destination:=cell.Offset(3, 0)
IN HERE
.Range("B1").AutoFilter field:=4
End If
Next cell
End With
End Sub

Thread Tools	Search this Thread
Show Printable Version	Search this Thread: Advanced Search
Display Modes
Switch to Linear Mode Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Macro recorded... tabs & file names changed, macro hangs	Steve	Excel Worksheet Functions	3	October 30th 09 11:41 AM
Macro to tidy data	dapouch	Excel Discussion (Misc queries)	4	October 6th 09 10:21 AM
Tidy up multiple find and replace code	PSM[_10_]	Excel Worksheet Functions	2	April 6th 09 02:00 PM
Tidy lookup	PBcorn	Excel Worksheet Functions	2	June 18th 08 08:05 AM
Tidy Up	Pete	Excel Discussion (Misc queries)	4	May 9th 05 05:09 PM

Menu

About Us