urgent help needed to clean up code

R

rbekka33

hi all,

this runs like a dog - no wonder - i have no idea what i am doing.
have just written this based on all the great contributions to thi
site and on recording macros.

If anyone can take the time to help me clean this up then i would b
eternally grateful. It takes a long time to run.

I have no idea really where to start as I am self taught and I don'
have time to do a course.

thanks so much.


Sub MatchData()


Application.ScreenUpdating = False
Selection.CurrentRegion.Select
ActiveWorkbook.Names.Add Name:="Data", RefersToR1C1:= _
"=OFFSET(Data!R1C1,0,0,COUNTA(Data!C1),COUNTA(Data!R1))"
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:
_
"Data!Data").CreatePivotTable TableDestination:="", TableName:
_
"CompareEngCodes", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3
1)
ActiveSheet.Cells(3, 1).Select
With ActiveSheet.PivotTables("CompareEngCodes").PivotFields("En
Code")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("CompareEngCodes").AddDataFiel
ActiveSheet.PivotTables( _
"CompareEngCodes").PivotFields("2004 Total"), "Count of 200
Total", xlCount
Range("B5").Select
Selection.Sort Key1:="R5C2", Order1:=xlDescending
Type:=xlSortValues, _
OrderCustom:=1, Orientation:=xlTopToBottom
ActiveSheet.Select
ActiveSheet.Move After:=Sheets(6)
ChDir "C:\Documents and Settings\Rebecca De Regt\Desktop"
Workbooks.Open Filename:= _
"C:\Documents and Settings\Rebecca D
Regt\Desktop\APFIG_Engagement_MonthlySource.xls"
Selection.AutoFilter
Selection.AutoFilter Field:=5, Criteria1:="=Banking an
Securities", _
Operator:=xlOr, Criteria2:="=Insurance"
Windows("APFIG_Engagement_MonthlySource.xls").Activate
Sheets("Data").Select
rng1 = "= Offset(Data!R2C1, 0, 0, CountA(Sheet1!C1), 1)"
Range("a2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Windows("APFIG Engagement Database V3.xls").Activate
Range("e5").Select
ActiveSheet.Paste
Range("g5").Select

ActiveCell.FormulaR1C1
"=IF(COUNTIF(R5C1:R5000C1,RC[-2])=0,RC[-2],"""")"
Selection.AutoFill Destination:=Range("G5:G7000")
Type:=xlFillDefault
'this range could be dynamic if i knew how

ActiveWorkbook.Names.Add Name:="BlanksRange", RefersTo:= _
"=OFFSET(Sheet1!$g$5,0,0,COUNTA(Sheet1!$A:$A),1)"
Visible:=True
ActiveWorkbook.Names.Add Name:="NoBlanksRange", RefersTo:= _
"=OFFSET(Sheet1!$h$5,0,0,COUNTA(Sheet1!$e:$e),1)"
Visible:=True
Range("H5").Select

Selection.FormulaArray = _

"=IF(ROW()-ROW(NoBlanksRange)+1>ROWS(BlanksRange)-COUNTBLANK(BlanksRange),"""",INDIRECT(ADDRESS(SMALL((IF(BlanksRange<>"""",ROW(BlanksRange),ROW()+ROWS(BlanksRange))),ROW()-ROW(NoBlanksRange)+1),COLUMN(BlanksRange),4)))"
Selection.AutoFill Destination:=Range("h5:h1000")
Type:=xlFillDefault
'this range could be dynamic if i knew how

Application.ScreenUpdating = True



End Su
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads


Top