Why do the Excel-windows look like this after the macro has been run?

[Razzy]

Hi!

The problem is most likely in the last part of the code.

The code works fine and does its job, but ends a little weird.


Thank you in advance.

Komplete code:

Sub Comparison()

Dim myFile As String
Dim myFile2 As String
Dim myFile3 As String

Dim myRegneark As String
Dim myRegneark2 As String
Dim myRegneark3 As String

Dim FilePicker As FileDialog

Dim arknavn As String
Dim arknavn2 As String
Dim arknavn3 As String


'Optimize Macro Speed
  Application.WindowState = xlMinimized
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual
  Application.DisplayAlerts = False

'*******************************
'Velger 3 stk. filer, hvis avbryt hopper den over
'*******************************
Set FilePicker = Application.FileDialog(msoFileDialogFilePicker)
    With FilePicker
      .Title = "Company © 2020: Velg kalkyle#1"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myFile = .SelectedItems(1)
    End With

'Hvis ikke valgt førstefil, avbryt
NextCode:
  myFile = myFile
  If myFile = "" Then GoTo Stop
 
 
Set FilePicker2 = Application.FileDialog(msoFileDialogFilePicker)
    With FilePicker2
      .Title = "Company © 2020: Velg kalkyle#2"
      .AllowMultiSelect = False
        .Show
        myFile2 = .SelectedItems(1)
    End With


Set FilePicker = Application.FileDialog(msoFileDialogFilePicker)
    With FilePicker
      .Title = "Company © 2020: Velg kalkyle#3"
      .AllowMultiSelect = False
        .Show
        myFile3 = .SelectedItems(1)
    End With


'Lage mappe på skrivebordet hvis ikke finnes
Dim path_ As String
    path_ = "C:\Users\" & Application.UserName & "\Desktop\Sammenligning - " & Date
Dim path2_ As String
    path2_ = "C:\Users\" & Application.UserName & "\Downloads\Sammenligning - " & Date
 
With CreateObject("Scripting.FileSystemObject")
    If Not .FolderExists(path_) Then .CreateFolder path_
    If Not .FolderExists(path2_) Then .CreateFolder path2_
    If .FolderExists(path2_) Then path_ = path2_
End With


'***********************
'Lagre filer i ny mappe
'***********************

    Workbooks.Open Filename:=myFile
    myRegneark = ActiveWorkbook.Name
    ActiveWorkbook.SaveAs Filename:=path_ & "\" & myRegneark, _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
       
       
    Workbooks.Open Filename:=myFile2
    myRegneark2 = ActiveWorkbook.Name
    ActiveWorkbook.SaveAs Filename:=path_ & "\" & myRegneark2, _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
              
              
    Workbooks.Open Filename:=myFile3
    myRegneark3 = ActiveWorkbook.Name
    ActiveWorkbook.SaveAs Filename:=path_ & "\" & myRegneark3, _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
       
       
       
'***********************
'Legge sammenstillings-ark inn i mal
'***********************
           
    Workbooks.Open Filename:=path_ & "\" & myRegneark
    arknavn = Left(myRegneark, Len(myRegneark) - 5)
    Sheets("Sammenstilling").Select
    ActiveSheet.Unprotect (1234)
    Sheets("Sammenstilling").Copy After:=Workbooks( _
        "Sammenligning_av_kalkark.xlsm").Sheets(1)
    Sheets("Sammenstilling").Name = arknavn
   
    Workbooks.Open Filename:=path_ & "\" & myRegneark2
    arknavn2 = Left(myRegneark2, Len(myRegneark2) - 5)
    Sheets("Sammenstilling").Select
    ActiveSheet.Unprotect (1234)
    Sheets("Sammenstilling").Copy After:=Workbooks( _
        "Sammenligning_av_kalkark.xlsm").Sheets(1)
    Sheets("Sammenstilling").Name = arknavn2
   
    Workbooks.Open Filename:=path_ & "\" & myRegneark3
    arknavn3 = Left(myRegneark3, Len(myRegneark3) - 5)
    Sheets("Sammenstilling").Select
    ActiveSheet.Unprotect (1234)
    Sheets("Sammenstilling").Copy After:=Workbooks( _
        "Sammenligning_av_kalkark.xlsm").Sheets(1)
    Sheets("Sammenstilling").Name = arknavn3
   
   
    'Når alle 3 er ferdige Lagre kopi av sammenligningarket/malen til mappe på skrivebord
    ActiveWorkbook.SaveCopyAs (path_ & "\Sammenligning.xlsm")
    Workbooks.Open Filename:=path_ & "\Sammenligning.xlsm"
   
    Workbooks("Sammenligning_av_kalkark.xlsm").Close SaveChanges:=False
  
    Windows("Sammenligning.xlsm").Activate
    Application.WindowState = xlMaximize

    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End


Stop:
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    ActiveWorkbook.Save
    Application.Quit
   
End Sub

 

[Razzy]

Maybe it is something with the:
Application.ScreenUpdating = True

Edit: I tried to have it true all the way and it works. But I dont wont to show the programs running. I will try and shift the position og the code Application.ScreenUpdating = True

Edit: Maybe before the opening of workbooks at the end, let me check

 

[Razzy]

Done! It had to be before the opening of workbooks at the end!

 

[Razzy]

Before I end, if sheet already exsist, how to add numeric value? Like: If "Donkey" exsist, add: "Donkey_1" and so on.

Workbooks.Open Filename:=path_ & "\" & myRegneark
    arknavn = Left(myRegneark, Len(myRegneark) - 5)
    Sheets("Sammenstilling").Select
    ActiveSheet.Unprotect (1234)
    Sheets("Sammenstilling").Copy After:=Workbooks( _
        "Sammenligning_av_kalkark.xlsm").Sheets(1)
    Sheets("Sammenstilling").Name = arknavn

Maype add a simple loop before:

Sheets("Sammenstilling").Copy After:=Workbooks( _
        "Sammenligning_av_kalkark.xlsm").Sheets(1)

 

[Razzy]

I think I can use IF function, because it is just up to three possible entries

 

[Razzy]

    Workbooks.Open Filename:=path_ & "\" & myRegneark2
    arknavn2 = Left(myRegneark2, Len(myRegneark2) - 5)
    Sheets("Sammenstilling").Select
    ActiveSheet.Unprotect (321)
    
If "TEST IF NAME IS NOT TAKEN" Then
        
   Sheets("Sammenstilling").Copy After:=Workbooks( _
        "Sammenligning_av_kalkark.xlsm").Sheets(1)
    Sheets("Sammenstilling").Name = arknavn2

Elseif  "TEST IF NAME IS NOT TAKEN"  
Sheets("Sammenstilling").Copy After:=Workbooks( _
        "Sammenligning_av_kalkark.xlsm").Sheets(1)
    Sheets("Sammenstilling").Name = arknavn2 & "_2"

Else
     Sheets("Sammenstilling").Copy After:=Workbooks( _
        "Sammenligning_av_kalkark.xlsm").Sheets(1)
    Sheets("Sammenstilling").Name = arknavn2 & "_3"
    End If

 

[Razzy]

Programming by a newbie, but it works:

Workbooks.Open Filename:=path_ & "\" & myRegneark
    arknavn = Left(myRegneark, Len(myRegneark) - 5)
    Sheets("Sammenstilling").Select
    ActiveSheet.Unprotect (321)
    Sheets("Sammenstilling").Copy After:=Workbooks( _
        "Sammenligning_av_kalkark.xlsm").Sheets(1)
    Sheets("Sammenstilling").Name = arknavn
    
    Workbooks.Open Filename:=path_ & "\" & myRegneark2
    arknavn2 = Left(myRegneark2, Len(myRegneark2) - 5)
    Sheets("Sammenstilling").Select
    ActiveSheet.Unprotect (321)
    Sheets("Sammenstilling").Copy After:=Workbooks( _
        "Sammenligning_av_kalkark.xlsm").Sheets(1)
    If Sheets(arknavn).Name = arknavn2 Then
    Sheets("Sammenstilling").Name = arknavn & "_2"
    End If
    
    Workbooks.Open Filename:=path_ & "\" & myRegneark3
    arknavn3 = Left(myRegneark3, Len(myRegneark3) - 5)
    Sheets("Sammenstilling").Select
    ActiveSheet.Unprotect (321)
    Sheets("Sammenstilling").Copy After:=Workbooks( _
        "Sammenligning_av_kalkark.xlsm").Sheets(1)
    If Sheets(arknavn).Name = arknavn3 Then
    Sheets("Sammenstilling").Name = arknavn & "_3"
    End If

 

[RoryA]

As a general rule, you should not use End on its own in your code.

 

[Razzy]

As a general rule, you should not use End on its own in your code.

Thanks for the tips