Command button takes forever to respond

[wal_verin]

Hi all,
For the past few days my command buttons have been working quite well but today as i try to do one new command button that finds and replace, suddenly the command button when pressed takes forever. Please can someone help me as i am approaching the deadline to present this. When i force the button to stop and try to search for the error it points to the code marked in red below and in quotes " Rows(i & ":" & i).Insert Shift:=xlDown" but this seems to have no problem. See my codes below

Option Explicit
Sub Button_sort_data()
Dim LR As Long, Found As Range
'Dim SortedData As Worksheet
Worksheets("Fortnoxbalans").Activate
Range("A1:F200", Range("A" & Rows.Count).End(xlUp)).Sort [A11], xlAscending


'Tar bort ej användbart data
LR = Range("A" & Rows.Count).End(xlUp).Row
LR = Range("B" & Rows.Count).End(xlUp).Row
LR = Range("C" & Rows.Count).End(xlUp).Row
Set Found = Columns("A").Find(what:="Anläggningstillgångar", LookIn:=xlValues, lookat:=xlWhole)
If Not Found Is Nothing Then Rows(Found.Row & ":" & LR).Delete
End Sub


Option Explicit


Sub Button_update_data()
'Declaring all the objects
Dim x As Worksheet, y As Worksheet, lastRow&
Dim lastRows As Long
Dim targetRow As Long
Dim Cell As Range


'Increasing speed commands
 Application.ScreenUpdating = False
 Application.EnableEvents = False




'Change the link to where you saved your files
Set x = Worksheets("Fortnoxbalans")
Set y = Worksheets("Avstämning")


lastRow = x.Cells.SpecialCells(xlCellTypeLastCell).Row


'Color code
'Application.FindFormat.Clear
'Application.FindFormat.Interior.ColorIndex = 2


x.Range("A1:A" & lastRow).Copy y.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
x.Range("B1:B" & lastRow).Copy y.Cells(Rows.Count, "B").End(xlUp).Offset(1, 0)
'x.Range("F1:F" & lastRow).Copy y.Cells(Rows.Count, "C").End(xlUp).Offset(1, 0)


Application.FindFormat.Interior.ColorIndex = 2


'This Code is responsible for inserting the new rows and start row 10
Dim TackleRows As Range
Dim Uprows As Long, i As Long, J As Long
Dim k As Long, L As Long, M As Range
Dim Downrows As Long, Middlerows As Long, Seprows As Long
Dim Borderrows As Long


 Set TackleRows = ThisWorkbook.Worksheets("Avstämning").UsedRange
 Uprows = TackleRows.Rows.Count
 Uprows = Uprows - (Uprows Mod 1)
 For i = Uprows To 9 Step -1
    Rows(i & ":" & i).Insert Shift:=xlDown
    Cells(i, "B").Value = "Enligt huvudbok"
 Next i
 'This is for the empty rows
 Middlerows = TackleRows.Rows.Count
 Middlerows = Middlerows - (Middlerows Mod 1)
 For J = Middlerows To 9 Step -2
     Rows(J & ":" & J).Insert Shift:=xlDown
     Cells(J, "B").Value = ""
 Next J
'This for the sum rows
Downrows = TackleRows.Rows.Count
 Downrows = Downrows - (Downrows Mod 1)
 For k = Downrows To 11 Step -3
    Rows(k & ":" & k).Insert Shift:=xlDown
    Cells(k, "B").Value = "Summa"
    'Cells(k, "B").Font.Bold = True
 Next k
 'This is the rows that separates between different account no
Seprows = TackleRows.Rows.Count
 Seprows = Seprows - (Seprows Mod 1)
 For L = Seprows To 11 Step -4
    Rows(L & ":" & L).Insert Shift:=xlDown
    Cells(L, "B").Value = ""
 Next L
 'Adding the Top and bottom borders to cell
  Borderrows = Cells(1, Columns.Count).End(xlToLeft).Column
For Each M In Range("$C$8:$C" & Cells(Rows.Count, "C").End(xlUp).Row)
If M.Row Mod 5 = 11 Then
With M.Resize(1, Borderrows).Borders(xlEdgeTop)
   .LineStyle = xlContinuous
   .Weight = xlThin
End With
With M.Resize(1, Borderrows).Borders(xlEdgeBottom)
  .LineStyle = xlDouble
  .Weight = xlThick
End With
End If
 Next M
 
 'Increasing Speed commands
  Application.ScreenUpdating = True
  Application.EnableEvents = True


  Application.CutCopyMode = False




'This is the codes for updating column C with the copied data from Column F in the fortnoxbalans
'Data entry will begin in row 9, so set targetRow to 9
    targetRow = 9
    
    'Find the last row of the data in column F on Fortnoxbalans sheet
    lastRows = Sheets("Fortnoxbalans").Range("F" & Rows.Count).End(xlUp).Row
    
    'For all the data in Fortnoxbalans column F
    For Each Cell In Sheets("Fortnoxbalans").Range("F1:F" & lastRows)
        
        'Enter every value of the cell in the odd rows of Test_Avst column C
        Sheets("Avstämning").Range("C" & targetRow).Value = Cell.Value
        
        'Increment targetRow by 5 so that it doesnot only hit the odd rows
         'but matches with the additional rows
        targetRow = targetRow + 5
    
    Next Cell


End Sub


Sub Button_delete_row()
'ActiveSheet.Unprotect "Lx71b2" 'Use this if it is password protected
 'ActiveSheet.Unprotect
 Application.ScreenUpdating = False
 Application.EnableEvents = False
 Application.Calculation = xlCalculationManual
'Setting the dimensions
Dim ChoiceCell As Range
Dim DeleteRng As Range
Dim Rply As String
For Each ChoiceCell In Selection
    If DeleteRng Is Nothing Then
        Set DeleteRng = ChoiceCell
      Else
        Set DeleteRng = Union(ChoiceCell, DeleteRng)
    End If
Next ChoiceCell
If Not DeleteRng Is Nothing Then DeleteRng.EntireRow.Interior.ColorIndex = 3
'Message to delete the rows
Rply = MsgBox("Är de rader som valdes de som ska tas bort?", vbYesNo)
If Rply = vbYes Then
DeleteRng.EntireRow.Delete
ActiveCell.Select
Else
    DeleteRng.EntireRow.Interior.ColorIndex = xlNone
    MsgBox "Inga rader togs bort."
End If
'ActiveSheet.Unprotect
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
'ActiveSheet.Protect "Lx71b2" 'Use this as the other code above when password protected
Exit Sub
'ActiveSheet.Protect "Lx71b2" 'Use this as the other code above when password protected


End Sub


Sub Button_insert_row()
Application.ScreenUpdating = False
Application.EnableEvents = False


Dim ChosenCell As Range
Dim InsertRange As Range
Dim x1None As Range
Dim Answer As String
'Now code for the chosen cell
     For Each ChosenCell In Selection
If InsertRange Is Nothing Then
     Set InsertRange = ChosenCell
Else
     Set InsertRange = Union(ChosenCell, InsertRange)
End If
Next ChosenCell
     If Not InsertRange Is Nothing Then InsertRange.EntireRow.Interior.ColorIndex = 2
     'Message about inserting row
Answer = MsgBox("Vill du infoga nya rad(er)?", vbYesNo)
'Depending on what the user clicks
If Answer = vbYes Then
InsertRange.EntireRow.Insert
ActiveCell.Select
Else
InsertRange.EntireRow.Interior.ColorIndex = 2
MsgBox ("Inga rad(er) har infogats. klicka på OK")


End If
     Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub


End Sub


Sub Button_jlonline_website()
Application.ScreenUpdating = False
Dim Confirm As String


Confirm = MsgBox("Är du säker på att du vill skicka månadsrapport?", vbYesNo)
If Confirm = vbNo Then
MsgBox "Du är inte klart med avstämningen"
Else
Shell ("Explorer https://www.google.com")
End If
  Application.ScreenUpdating = True
  Exit Sub
End Sub


Sub Button_clear_signature()
Range("A8:A1000").ClearContents
Range("B8:B1000").ClearContents
Range("C8:C1000").ClearContents
Range("D8:D1000").ClearContents




End Sub


Sub Button_replace_and_check()
Dim v As Worksheet, w As Worksheet
Dim LRow As Long, Cell As Range
Dim Kontonr As Range
'Dim Startrow As Long
'Dim icount As Long


'The worksheets are now set
Set v = Worksheets("Fortnoxbalans")
Set w = Worksheets("Avstämning")




'Determines the last row in Sheet Fortnoxbalans
LRow = v.Cells(v.Rows.Count, "A").End(xlUp).Row
'Start a loop for all the kontonr in Fortnoxbalans


For Each Cell In v.Range("A1:A" & LRow)
'Search the kontonr for the current cell value
    Set Kontonr = w.Range("A8:A300").Find(Cell.Value)
    'If the kontonr was found in Sheet Avstämning
    If Not Kontonr Is Nothing Then
    'The two cells next the kontonr
        w.Range("B" & Kontonr.Row & ":C" & Kontonr.Row).Value = v.Range("B" & Cell.Row & ":F" & Cell.Row).Value
    Else
    'Adding the unfound ones at the end with an increment of 1 row each
        LRow = w.Cells(w.Rows.Count, "A").End(xlUp).Row + 1
        w.Range("A" & LRow & ":C" & LRow).Value = v.Range("A" & Cell.Row & ":F" & Cell.Row).Value
    End If
   
   'Continue to the next cell in the loop
Next Cell
Exit Sub
End Sub

 

[SpillerBD]

You cannot insert a row iif it would force data past the last row available. Therefore it sounds like the loop is going through the 1million+ rows on the sheet. That always takes a bit of time.