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
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