Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Tidy up macro!
I have a macro which is made up of seven macros which do almost exactly the
same thing. The only thing that differs each time is the cell that is copied and the destination of the filtered information. A2 is copied into D1 on sheet2 and column D is then filtered and if any data is found it is copied to A5 on sheet1. This process is repeated 7 times for dates in A2:G2 What I would like to do is simplify the process by not having the same code used 7 times. Is this possible? I have enclosed one of the macros so that you can see how it is done. Sub Checkdate1() If Not IsEmpty(Worksheets("Sheet1").Range("A2").Value) Then Worksheets("Sheet2").Range("D1").Value = Worksheets("Sheet1").Range("A2").Value Range("B1").AutoFilter Field:=4, Criteria1:="=6" Set rng = ActiveSheet.AutoFilter.Range Set rng1 = Intersect(rng, Columns(2)).SpecialCells(xlVisible) If rng1.Count <= 1 Then Selection.AutoFilter Field:=4 Exit Sub End If Set rng = rng.Offset(1, 0).Resize(rng.Rows.Count - 1, rng.Columns.Count) Set rng = Intersect(rng, Range("C:C")) rng.Copy Worksheets("Sheet1").Range("A5") Selection.AutoFilter Field:=4 End If End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Tidy up macro!
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) .Range("B1").AutoFilter field:=4 End If Next cell End With End Sub Things I don't understand: 1) Why you copy the value from Sheet1!A2 to Sheet2!D1 and then don't use it anywhere. 2) Your Criteria1 is fixed, rather than dependent on Sheet1!A2 - is that right (if it is, it will return the same data each time)? If it should be dependent on Sheet1!A2, then replace Criteria1:="=6" with Criteria1:="=" & cell.Value 3) Why you're a) filtering on column D, b) checking for visible cells in column B, and c) Copying column C. Note that by using Columns(2) for your Intersect().SpecialCells, you'll get an error if there are no visible cells in column B Note also that the returned values will start in the first row that meets Criteria1. If the data is not sorted on column 4, the returned values will include data that is not visible in the autofilter. In article , "Gareth" wrote: I have a macro which is made up of seven macros which do almost exactly the same thing. The only thing that differs each time is the cell that is copied and the destination of the filtered information. A2 is copied into D1 on sheet2 and column D is then filtered and if any data is found it is copied to A5 on sheet1. This process is repeated 7 times for dates in A2:G2 What I would like to do is simplify the process by not having the same code used 7 times. Is this possible? I have enclosed one of the macros so that you can see how it is done. Sub Checkdate1() If Not IsEmpty(Worksheets("Sheet1").Range("A2").Value) Then Worksheets("Sheet2").Range("D1").Value = Worksheets("Sheet1").Range("A2").Value Range("B1").AutoFilter Field:=4, Criteria1:="=6" Set rng = ActiveSheet.AutoFilter.Range Set rng1 = Intersect(rng, Columns(2)).SpecialCells(xlVisible) If rng1.Count <= 1 Then Selection.AutoFilter Field:=4 Exit Sub End If Set rng = rng.Offset(1, 0).Resize(rng.Rows.Count - 1, rng.Columns.Count) Set rng = Intersect(rng, Range("C:C")) rng.Copy Worksheets("Sheet1").Range("A5") Selection.AutoFilter Field:=4 End If End Sub |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Tidy up macro!
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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Tidy up macro!
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Macro recorded... tabs & file names changed, macro hangs | Excel Worksheet Functions | |||
Macro to tidy data | Excel Discussion (Misc queries) | |||
Tidy up multiple find and replace code | Excel Worksheet Functions | |||
Tidy lookup | Excel Worksheet Functions | |||
Tidy Up | Excel Discussion (Misc queries) |