Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Slow procedure
I have modified a procedure I downloaded from Debra Dalgleish's site and show the detail
as below. Basically it looks at a range of values then creates a named worksheet for each of these values if that worksheet does not already exist. If it does exist it just clears some ranges and copies in some filtered data. I would be grateful if someone could have a quick look through to see if I have put in anything in such a way that it would really slow the operation of the procedure. Don't get me wrong, the procedure does exactly what it is ecpected to do , it just seems to take a bit of time and I just wonder if there is anything slowing it. I am sorry I have notes above each operation as I am not the sharpest pencil in the box when it come to programming and I need to keep track of what I am trying to do. Don't spend a lot of time on it, as I say it works and is liveable with. Sub ExtractFields() Dim ws1 As Worksheet Dim wsNew As Worksheet Dim rng As Range Dim r As Integer Dim c As Range Set ws1 = Sheets("FieldMaster") Set rng = Range("DatabaseList") Application.ScreenUpdating = False r = Sheets("Entries").Cells(Rows.Count, "A").End(xlUp).row For Each c In Sheets("Entries").Range("A12:A" & r) ' check if sheet exists If WksExists(c.Value) Then 'Clear existing sheet areas if sheet already exists Sheets(c.Value).Range("B12:E15").ClearContents Sheets(c.Value).Range("B23:E28").ClearContents Sheets(c.Value).Range("J12:N15").ClearContents Sheets(c.Value).Range("J23:N28").ClearContents ' run advanced filter to get organic applications rng.AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Sheets(c.Value).Range("Q1:Q2"), _ CopyToRange:=Sheets(c.Value).Range("C11:E11"), _ Unique:=False Else 'If sheet does not exist add it Set wsNew = Sheets.Add ' enter after last sheet wsNew.Move After:=Worksheets(Worksheets.Count) ' name the sheet wsNew.Name = c.Value ' copy template to new sheet Sheets("FieldBase").Cells.Copy Destination:=wsNew.Range("A1").Cells ' Enter field name into FieldMaster for soils copy Sheets("FieldMaster").Range("AA2").Value = wsNew.Name ' Copy base soil to Soils sheet Range("SoilBase").Copy Sheets("Soils").Cells(Rows.Count, 1).End(xlUp)(2) ' enter sheet name in reference cell wsNew.Range("B2").Value = wsNew.Name ' put field name into filter criteria to allow for alphanumerics wsNew.Range("Q2").Formula = "=""=" & wsNew.Range("B2").Value & """" ' run advanced filter to get organic applications rng.AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=wsNew.Range("Q1:Q2"), _ CopyToRange:=wsNew.Range("C11:E11"), _ Unique:=False End If Next ws1.Select End Sub Function WksExists(wksName As String) As Boolean On Error Resume Next WksExists = CBool(Len(Worksheets(wksName).Name) 0) End Function |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Slow procedure
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Slow procedure
Don Guillett wrote:
I think I might try to do the create if not created sheet FIRST. I did have a go at this but it doesn't seem to have had much of an effect. I think I will just live with it. Your help was much appreciated. Many thanks. Graham |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Slow Procedure | Excel Programming | |||
Slow Excel Navigation with Up / Down Arrow and slow scrolling | Excel Discussion (Misc queries) | |||
How to jump from a Form procedure to a Workbook or Module procedure? | Excel Programming | |||
Calling a procedure in a procedure | Excel Programming |