Makro langsam nach erster Ausführung

Private Sub CommandButton1_Click() 'Update detailed sheet with country values
Dim v_SheetName As Variant
Dim v_color_index As Variant
Dim v_checkSheet As Variant
Dim ws As Worksheet
Dim x As Integer
v_SheetName = UCase(ActiveCell.Value)
v_color_index = ActiveCell.Interior.ColorIndex
If MsgBox("Do you want to run the Update for Country: " & UCase(v_SheetName) & "?", _
vbYesNo + vbQuestion + vbDefaultButton1, "Question") = vbNo Then
Cancel = True
ElseIf SheetExists(v_SheetName) Then
Update_Country_Status v_SheetName, v_color_index 'CALL Update Procedure with current  _
sheet name
Else
MsgBox ("Country Sheet does not exist. Add Country to Excel File")
End If
End Sub

Option Explicit 'All variables needs to be declared
Sub Update_Country_Status(v_SheetName As Variant, v_color_index As Variant)
' Macro to update Sheet "DETAILED ALL FUNDS" with the latest information from the Countries  _
sheets
' Version updates and changes:
' 19-FEB-2010:
' TRIM Added to concatenate the fund,subfund,category and class in DETAILED ALL FUNDS sheet ( _
ignores blanks at the beginning and end)
' Copy Sheets to a new excel file including non-default color and date handling via Button in   _
_
Country Sheet
Dim rCell As Range
Dim lReply As Long
Dim v_searchValue As String
Dim v_CategoryClass As String
Dim v_UpdateValue As String
Dim v_CellColorCountrySheet As Long
Dim v_Country As String
Dim v_registrationDate As String
Dim v_FundSubFund As String
Dim v_FundSubFundRow As Long 'Fund and Subfund Row in Country sheet
Dim v_FundSubFundAddress As String
Dim v_noFundFound As Integer ' If template layout is wrong or Funds not inserted in  _
DETAILED ALL FUNDS sheet, no update will be done and msg box shown to user with advise
Dim v_CountryName As String 'selects the country name currently to be updated in "detailed   _
_
all funds" sheet
Dim v_CountryColumnNumber As Long 'selects column number of the country to be updated in  _
order to select the cell
Dim i As Integer
Dim v_CellToUpdateAddress As String
'Unhide temp sheet
Sheets("temp").Visible = True
' insert concatenation from Fund,subfund,category,class in column A to create unique identifier
Application.ScreenUpdating = False 'stops flickering
Worksheets("DETAILED ALL FUNDS").Activate
ActiveSheet.Outline.ShowLevels RowLevels:=2 ' Ungroup in case sheet is grouped
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("A4").Select
ActiveCell.FormulaR1C1 = "=trim(RC[1])&trim(RC[2])&trim(RC[3])&trim(RC[4])" 'Blanks at the   _
_
beginning and the end of each cell are removed
Range("A4").Select
Selection.AutoFill Destination:=Range("A4:A65000"), Type:=xlFillDefault
Range("A4:A65000").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A4").Select
Application.CutCopyMode = False
'Clear temp sheet to insert data from Country Sheet
Worksheets("temp").Activate
Cells.Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Range("A1").Select
' Paste Values from Country Sheet into temp Sheet
'MsgBox UCase(v_SheetName) & " will be updated"
Sheets(v_SheetName).Select
Cells.Select
Selection.Copy
Range("C4").Select
Worksheets("temp").Activate
Sheets("temp").Select
Cells.Select
ActiveSheet.Paste
Range("C4").Select
' loop trough Funds and Sub Funds until an empty cell is reached
Do Until IsEmpty(ActiveCell)
Worksheets("temp").Activate
i = 1 ' to check whether Fund/Subfund level has to be udpated or Fund/Subfund/Category/ _
Class Level
' Information from current country sheet selected. This information are used to update the  _
DETAILED ALL FUNDS SHEET
v_FundSubFund = ActiveCell.Offset(0, 0).Value & ActiveCell.Offset(0, 1).Value
v_FundSubFundRow = ActiveCell.Row
v_Country = ActiveCell.Offset(0, -2).Value
v_registrationDate = ActiveCell.Offset(0, -1).Value
v_FundSubFundAddress = ActiveCell.Address
Range("E2").Select 'After one fund/subfund has been searched for all Categories, next  _
subfund will be searched and has to start with the first category/class again
' loop through Categories and classes
Do Until IsEmpty(ActiveCell)
v_CategoryClass = ActiveCell.Offset(0, 0).Value & ActiveCell.Offset(1, 0).Value
v_UpdateValue = ActiveCell.Offset(v_FundSubFundRow - 2, 0).Value
v_CellColorCountrySheet = ActiveCell.Offset(v_FundSubFundRow - 2, 0).Interior.ColorIndex
If i = 1 Then
v_searchValue = v_FundSubFund
Else
v_searchValue = v_FundSubFund & v_CategoryClass
End If
Worksheets("DETAILED ALL FUNDS").Activate
Range("A1").Select
'search in DETAILED ALL FUNDS sheet for the value of variable v_searchValue (Fund/Subfund or  _
Fund/Subfund/Category/Class)
On Error Resume Next
Set rCell = Cells.Find(v_searchValue, After:=Cells(1, 1), LookIn:=xlValues)
If Not rCell Is Nothing Then
v_CellToUpdateAddress = rCell.Address
v_noFundFound = v_noFundFound + 1 'At least one fund has been found. Therefore increase  _
_
of variable
Range(v_CellToUpdateAddress).Select
'If i  1 Then
'MsgBox ("Cell " & v_CellToUpdateAddress & " with Fund " & rCell & " has been found") '  _
_
to check which fund has been found
'End If
' Select position of country dynamically
Set rCell = Nothing
Set rCell = Cells.Find(v_Country, After:=Cells(1, 1), LookIn:=xlValues)
v_CountryName = rCell.Value 'If country to be updated is in detailed all funds sheet,   _
_
select the column number
v_CountryColumnNumber = rCell.Column
' Country to update. case statements below based on sheet "Countries" with list of all  _
countries
Select Case v_Country
Case v_CountryName
ActiveCell.Offset(0, v_CountryColumnNumber - 1).Select ' select the country and  _
jump to the cell (same line, column determined by country name)
End Select
v_CellToUpdateAddress = ActiveCell.Address
If i = 1 Then
Sheets("DETAILED ALL FUNDS").Range(v_CellToUpdateAddress).Value =  _
v_registrationDate
ElseIf v_UpdateValue  "" Then
Sheets("DETAILED ALL FUNDS").Range(v_CellToUpdateAddress).Value = v_UpdateValue
Sheets("DETAILED ALL FUNDS").Range(v_CellToUpdateAddress).Interior.ColorIndex =  _
_
v_color_index 'Default color per country from country sheet
Else
Sheets("DETAILED ALL FUNDS").Range(v_CellToUpdateAddress).Value = v_UpdateValue
Sheets("DETAILED ALL FUNDS").Range(v_CellToUpdateAddress).Interior.ColorIndex =  _
_
v_CellColorCountrySheet 'Color from country sheet
End If
End If
Worksheets("temp").Activate
If Not i = 1 Then
ActiveCell.Offset(0, 1).Select ' Loop trough all Categories/Classes
End If
i = 2 ' increase variable i to get loop now through the categories
Application.StatusBar = "Currently updated: " & v_FundSubFund 'Status Bar
Loop 'inner loop (through categories/classes)
Range(v_FundSubFundAddress).Select
ActiveCell.Offset(1, 0).Select 'After all Categories/Classes are checked for one fund/Sub-  _
_
fund go to next Fund/Sub Fund
Loop 'Outer loop (through funds/subfunds)
' After all updates done, cleanup
On Error GoTo 0
Worksheets("DETAILED ALL FUNDS").Activate
Columns("A:A").Delete ' Delete Concatenated Column
Columns("F:AH").Select
With Selection
.ColumnWidth = 9 ' Column width fixed to 9
.HorizontalAlignment = xlCenter
.Font.Name = "Arial Narrow"
.Font.Size = 8
End With
Range("A1").Select ' back to first cell after all updates
If v_noFundFound = 0 Then
MsgBox ("Check Template Format or add new Funds to Detailed all Funds Sheets. No Fund has   _
_
been found and nothing has been updated")
Else
MsgBox ("Update finished for: " & v_SheetName & ". " & v_noFundFound & " cells found and  _
updated according to " & v_SheetName & " sheet")
End If
Sheets("temp").Visible = False 'Hide temp sheet
Worksheets("DETAILED ALL FUNDS").Select
Application.StatusBar = False ' Give Status Bar back to excel
Application.ScreenUpdating = True 'Give control back to excel
End Sub