Problem to go to Window

Hi,
I get
21i.png
due to last line below

    Dim User0 As String, Message0 As String, Window1 As String, Command0 As String
    Window1 = ThisWorkbook.FullName

Rep0:   Windows(Window1).Activate

Open in new window

What to adjust?
LVL 12
HuaMin ChenProblem resolverAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Ryan ChongBusiness Systems Analyst , ex-Senior Application EngineerCommented:
quick try:

workbooks(Window1).Activate

(if this is not working, try: workbook(Window1).Activate )

or directly:

Thisworkbook.activate
HuaMin ChenProblem resolverAuthor Commented:
I want to go to given file name from another window. How?
Fabrice LambertConsultingCommented:
hi,

The fullName property return the path of the workbook.
The workbooks collection is indexed either with a number or with workbook names (totally different from workbook paths).
So you should use the name property instead of the fullName property.

Also, to activate a workbook, you should refer to the application object, not the Windows object.
Window1 = ThisWorkbook.Name
Application.workbooks(Window1).Activate

Open in new window

Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

HuaMin ChenProblem resolverAuthor Commented:
Sorry, I still get

21K.png
due to last line below
...
Rep0:   'Windows(Window1).Activate
    Application.Workbooks(Window1).Activate

Open in new window

Fabrice LambertConsultingCommented:
What's stored in the Window1 variable ?
Is the workbook already open ?
HuaMin ChenProblem resolverAuthor Commented:
I also get
21o.png
due to 1st line below. Why?
    With Worksheets("Main Sheet").Range("AJ1:AJ50000")
        Set c = .Find(Search0, LookIn:=xlValues)
        If Not c Is Nothing Then

Open in new window

Fabrice LambertConsultingCommented:
Upload your document, we can't say much with just these few lines as it looks perfectly valid.
HuaMin ChenProblem resolverAuthor Commented:
Here is the whole event

Private Sub CommandButton9_Click()
    Application.DisplayAlerts = True
    Dim User0 As String, Message0 As String, Window1 As String, Command0 As String
    Window1 = ThisWorkbook.FullName
    User0 = Environ("Username")
    If UCase(Mid(User0, 1, 5)) <> "NUSKY" And UCase(Mid(User0, 1, 11)) <> "CHAN.EDWARD" And UCase(Mid(User0, 1, 12)) <> "CHEANG.AMPEL" Then
        MsgBox "You're not given with the permission to create Departure List.", vbExclamation, "Message"
        Exit Sub
    End If
    
    'FSO.deletefile Application.ActiveWorkbook.Path & "\Departure List (of People already left).xls", True
    'Command0 = "cmd /c delete /y """ & Application.ActiveWorkbook.Path & "\Departure List (of People already left).xls" & """ "
    'Shell (Command0)
    Dim Name0 As String, fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    Debug.Print Application.ActiveWorkbook.Path
    Name0 = Application.ActiveWorkbook.Path & "\Departure List (of People already left).xls"
    If fso.FileExists(Name0) Then
        fso.DeleteFile Name0
    End If
    Name0 = Application.ActiveWorkbook.Path & "\Departure List (of People already left).xlsx"
    If fso.FileExists(Name0) Then
        fso.DeleteFile Name0
    End If
    
    Name0 = Application.ActiveWorkbook.Path & "Departure List (of People already left).xls"
    Set NewBook = Workbooks.Add
    With NewBook
        .Title = "Departure List (of People already left)"
        .Subject = "Departure List"
        .SaveAs Filename:=Name0
    End With

    Do While Name0 = ""
        Name0 = InputBox("Please provide name of people to search:", "Name of People", 1)
        
        If (Name0 = "") Then
        
            Dim Ans0 As Integer
            Ans0 = MsgBox("Do you want to give up your current search?", vbYesNo + vbQuestion, "Re-try")
            
            If Ans0 = vbYes Then
                Exit Sub
            End If
        End If
    Loop
    
    Dim Time0 As Boolean, cnt0 As Integer, File0 As String, Title0 As String, Window0 As String, RowID0 As String, Var1 As String, Var2 As String, Var3 As String, Var4 As String, Var5 As String, Var6 As String, Var7 As String, Var8 As String, Var9 As String, Var10 As String, Var11 As String
    Time0 = True: cnt0 = 1: File0 = Application.ActiveWorkbook.Path & "\Departure List (of People already left).xlsx": Title0 = "Departure List (of People already left)": Window0 = "Departure List (of People already left).xlsx"
    
Rep0:   'Windows(Window1).Activate
    'Debug.Print Window1
    'Application.Workbooks(Window1).Activate
    With Worksheets("Main Sheet").Range("AJ1:AJ50000")
        Set c = .Find(Search0, LookIn:=xlValues)
        If Not c Is Nothing Then
        
            Var1 = Worksheets("Main Sheet").Cells(c.Row, 3).Value
            Var2 = Worksheets("Main Sheet").Cells(c.Row, 4).Value
            Var3 = Worksheets("Main Sheet").Cells(c.Row, 5).Value
            Var4 = Worksheets("Main Sheet").Cells(c.Row, 6).Value
            Var5 = Worksheets("Main Sheet").Cells(c.Row, 7).Value
            Var6 = CStr(Worksheets("Main Sheet").Cells(c.Row, 8).Value)
            Var7 = Worksheets("Main Sheet").Cells(c.Row, 9).Value
            Var8 = CStr(Worksheets("Main Sheet").Cells(c.Row, 16).Value)
            Var9 = CStr(Worksheets("Main Sheet").Cells(c.Row, 17).Value)
            Var10 = CStr(Worksheets("Main Sheet").Cells(c.Row, 19).Value)
            Var11 = Worksheets("Main Sheet").Cells(c.Row, 20).Value
            
            RowID0 = CStr(c.Row) & "CC"
            'Windows(Window0).Activate
            Application.Workbooks(Window0).Activate
            If cnt0 = 1 Then
                Set HOBook = Workbooks.Add
                With HOBook
                    .Title = Title0
                    .Subject = Title0
                    .SaveAs Filename:=File0, FileFormat:=XlFileFormat.xlOpenXMLWorkbookMacroEnabled
                    .Close SaveChanges:=False
                End With
                
                Worksheets("Sheet1").Cells(1, 1).Value = "Country"
                Worksheets("Sheet1").Cells(1, 2).Value = "Site Code"
                Worksheets("Sheet1").Cells(1, 3).Value = "LCC"
                Worksheets("Sheet1").Cells(1, 4).Value = "IT Tag No."
                Worksheets("Sheet1").Cells(1, 5).Value = "Record Status"
                Worksheets("Sheet1").Cells(1, 6).Value = "Asset Register Month (MM/YYYY)"
                Worksheets("Sheet1").Cells(1, 7).Value = "Expenses/Asset Type"
                Worksheets("Sheet1").Cells(1, 8).Value = "Expenses/Asset Description"
                Worksheets("Sheet1").Cells(1, 9).Value = "Starting Date (DD/MMM/YYYY)"
                Worksheets("Sheet1").Cells(1, 10).Value = "Invoice Date (DD/MMM/YYYY)"
                Worksheets("Sheet1").Cells(1, 11).Value = "Aging As Of Today"

                With Worksheets(File0).Columns("A")
                 .ColumnWidth = .ColumnWidth * 2
                End With

                With Worksheets(File0).Columns("B")
                 .ColumnWidth = .ColumnWidth * 2
                End With

                With Worksheets(File0).Columns("D")
                 .ColumnWidth = .ColumnWidth * 2
                End With

                With Worksheets(File0).Columns("E")
                 .ColumnWidth = .ColumnWidth * 2
                End With

                With Worksheets(File0).Columns("F")
                 .ColumnWidth = .ColumnWidth * 3.5
                End With

                With Worksheets(File0).Columns("G")
                 .ColumnWidth = .ColumnWidth * 3
                End With

                With Worksheets(File0).Columns("H")
                 .ColumnWidth = .ColumnWidth * 4
                End With

                With Worksheets(File0).Columns("I")
                 .ColumnWidth = .ColumnWidth * 3.5
                End With

                With Worksheets(File0).Columns("J")
                 .ColumnWidth = .ColumnWidth * 3.5
                End With

                With Worksheets(File0).Columns("K")
                 .ColumnWidth = .ColumnWidth * 3.5
                End With
                
            End If
            
            With Worksheets("Sheet1").Range("Z1:AZ50000")
            Set c1 = .Find(RowID0, LookIn:=xlValues)
            
            If c1 Is Nothing Then
                Worksheets("Sheet1").Cells(cnt0 + 1, 1).Value = Var1
                Worksheets("Sheet1").Cells(cnt0 + 1, 2).Value = Var2
                Worksheets("Sheet1").Cells(cnt0 + 1, 3).Value = Var3
                Worksheets("Sheet1").Cells(cnt0 + 1, 4).Value = Var4
                Worksheets("Sheet1").Cells(cnt0 + 1, 5).Value = Var5
                Worksheets("Sheet1").Cells(cnt0 + 1, 6).Value = Var6
                Worksheets("Sheet1").Cells(cnt0 + 1, 7).Value = Var7
                Worksheets("Sheet1").Cells(cnt0 + 1, 8).Value = Var8
                Worksheets("Sheet1").Cells(cnt0 + 1, 9).Value = Var9
                Worksheets("Sheet1").Cells(cnt0 + 1, 10).Value = Var10
                Worksheets("Sheet1").Cells(cnt0 + 1, 11).Value = Var11
                
                Worksheets("Sheet1").Cells(cnt0 + 1, 52).Value = RowID0
                
            Else
                'Windows(Window1).Activate
                Application.Workbooks(Window1).Activate
                Exit Sub
            End If
            
            End With
            
            cnt0 = cnt0 + 1
            
            GoTo Rep0
        Else
            If Time0 Then
                MsgBox "No relevant inventory records are found, per your given user name.", vbExclamation, "Message"
                'Windows(Window1).Activate
                Application.Workbooks(Window1).Activate
                Exit Sub
            End If
        End If
        
        'Windows(Window1).Activate
        Application.Workbooks(Window1).Activate
    End With
    Time0 = False
    
End Sub

Open in new window

Fabrice LambertConsultingCommented:
First,
I notice that beside the advices we gave you about the workbook activate method, you did not made any change.

Second,
You manipulate many workbooks and use context dependant objects (activeWorkbook, the generic workbooks collection), it wouldn't surprise me that these objects state arn't the ones you expect.
These objects are chaotic (a simple click from the user can change them), and should be avoided like pest.

Third:
Your function do too many things and break the SRP (Single Responsibility Principle).
You should split it into several small functions, each one doing only one thing and do it well (instead of one function that do several things badly).

Fourth:
No document.
HuaMin ChenProblem resolverAuthor Commented:
If I do not expect to change it to have smaller events, what to adjust to correct the error?
Fabrice LambertConsultingCommented:
Upload your workbooks.

I'm afraid it will be too complex to explain you what need to be fixed in your codes (too many mistakes).
HuaMin ChenProblem resolverAuthor Commented:
What to adjust, to correct
21w.png
which is due to this line
            Application.Workbooks(Window0).Close SaveChanges:=False

when I click button Generate Departure list (within Main Sheet) to attached file.
Asset-Template-HK-Test.xlsm
Fabrice LambertConsultingCommented:
I can only guess that's bc the workbbook was closed at some point as when the error occure, only the workbook executing the code is open.

The function is a real mess as it keep openning / closing workbooks.
What about explaining what it is supposed to do ?
It might be faster to give you a well designed code than trying to fix the unfixable.
HuaMin ChenProblem resolverAuthor Commented:
I am to search Main sheet of current workbook and copy records into Departure list Excel file.

How to resolve current problem?
Fabrice LambertConsultingCommented:
Please, elaborate.

I can't offer a solution with so litlle infos.
HuaMin ChenProblem resolverAuthor Commented:
I get
21y.pngdue to this line

                Application.Workbooks(Window1).Activate

when clicking Generate Departure List (on Main Sheet) of attached file.
Asset-Template-HK-Test.xlsm
Fabrice LambertConsultingCommented:
I already answered this in one of my previous answer.

I also asked that you explain precisely what you want to achieve so we can provide a solution.
As it stand, your source code is barely understandable, better redo it from scratch.
HuaMin ChenProblem resolverAuthor Commented:
I want to search current Excel file and then copy records to Departure New Excel file. Where is the problem?
Fabrice LambertConsultingCommented:
Wich columns do you need ?
How do I know wich rows to copy ?
In other words, what are your search criteria ?
HuaMin ChenProblem resolverAuthor Commented:
It is to do a search on AJ column for specific user name and then copy columns C to I, P, Q and S, to new Departure Excel list.
Fabrice LambertConsultingCommented:
Based on what you said, replace the CommandButton9_Click procedure by the following:
Private Sub CommandButton9_Click()
    If (checkPermission) Then
        Dim name As String
        Do While name = vbNullString
            name = InputBox("Please provide name of people to search:", "Name of People")
            If (name = vbNullString) Then
                Dim answer As VbMsgBoxResult
                answer = MsgBox("Do you want to give up your current search?", vbYesNo + vbQuestion, "Re-try")
                If answer = vbYes Then
                    Exit Sub
                End If
            Else
                If (Not getDepartureList(name)) Then
                    MsgBox "Found nothing", vbOKOnly + vbExclamation
                End If
            End If
        Loop
    Else
        MsgBox "You're not given with the permission to create Departure List.", vbExclamation, "Message"
    End If
End Sub

Private Function checkPermission() As Boolean
    Dim USER As String
    USER = Environ("USERNAME")
    If UCase(Mid(USER, 1, 5)) <> "NUSKY" And UCase(Mid(USER, 1, 11)) <> "CHAN.EDWARD" And UCase(Mid(USER, 1, 12)) <> "CHEANG.AMPEL" Then
        checkPermission = False
    Else
        checkPermission = True
    End If
End Function

Private Function getDepartureList(ByVal name As String) As Boolean
        '// refer to source workbook
    Dim wbSrc As Excel.Workbook
    Set wbSrc = ThisWorkbook
    
        '// refer to source worksheet
    Dim wsSrc As Excel.Worksheet
    Set wsSrc = wbSrc.Worksheets("Main Sheet")
    
        '// create the target workbook
    Dim wbTrg As Excel.Workbook
    Set wbTrg = Application.Workbooks.Add

        '// refer to target worksheet
    Dim wsTrg As Excel.Worksheet
    Set wsTrg = wbTrg.Worksheets(1)
        '// add header row
    addHeaders wsTrg
    
    Const COUNTRY = 3
    Const SITE_CODE = 4
    Const LCC = 5
    Const IT_TAG_NO = 6
    Const RECORD_STATUS = 7
    Const ASSET_REGISTER_MONTH = 8
    Const EXPENSES_ASSET_TYPE = 9
    Const EXPENSES_ASSET_DESCRIPTION = 11
    Const STARTING_DATE = 17
    Const INVOICE_DATE = 19
    Const AGING_AS_OF_TODAY = 20
    Const USER = 36
    
        '// first row where data will be written
    Dim row As Excel.Range
    Set row = wsTrg.Range("A2:K2")
    
        '// perform the search
    With wsSrc.Range("AJ:AJ")
        Dim search As Excel.Range
        Set search = .Find(name, LookIn:=xlValues)
        If Not (search Is Nothing) Then
            Dim firstAddress As String
            firstAddress = search.Address
            Do
                    '// write data
                row.Cells(1).Value = search.EntireRow.Cells(COUNTRY).Value
                row.Cells(2).Value = search.EntireRow.Cells(SITE_CODE).Value
                row.Cells(3).Value = search.EntireRow.Cells(LCC).Value
                row.Cells(4).Value = search.EntireRow.Cells(IT_TAG_NO).Value
                row.Cells(5).Value = search.EntireRow.Cells(RECORD_STATUS).Value
                row.Cells(6).Value = search.EntireRow.Cells(ASSET_REGISTER_MONTH).Value
                row.Cells(7).Value = search.EntireRow.Cells(EXPENSES_ASSET_TYPE).Value
                row.Cells(8).Value = search.EntireRow.Cells(EXPENSES_ASSET_DESCRIPTION).Value
                row.Cells(9).Value = search.EntireRow.Cells(STARTING_DATE).Value
                row.Cells(10).Value = search.EntireRow.Cells(INVOICE_DATE).Value
                row.Cells(11).Value = search.EntireRow.Cells(AGING_AS_OF_TODAY).Value
                Set search = .FindNext(search)
                Set row = row.Offset(rowoffset:=1)
            Loop While search.Address <> firstAddress
                '/////////////////////////////////
                '// Call a function doing cells formatting here if needed
                '/////////////////////////////////
                
                
                '// save the workbook (overwrite if needed)
            Application.DisplayAlerts = False
            wbTrg.SaveAs ThisWorkbook.Path & "\Departure List (of People already left).xlsx"
            Application.DisplayAlerts = True
            wbTrg.Activate
            getDepartureList = True
        Else
            wbTrg.Close savechanges:=False
            getDepartureList = False
        End If
    End With
    Set row = Nothing
    Set wsSrc = Nothing
    Set wbSrc = Nothing
    Set wsTrg = Nothing
    Set wbTrg = Nothing
End Function

Private Sub addHeaders(ByRef ws As Excel.Worksheet)
    ws.Cells(1, 1).Value = "Country"
    ws.Cells(1, 2).Value = "Site Code"
    ws.Cells(1, 3).Value = "LCC"
    ws.Cells(1, 4).Value = "IT Tag No."
    ws.Cells(1, 5).Value = "Record Status"
    ws.Cells(1, 6).Value = "Asset Register Month (MM/YYYY)"
    ws.Cells(1, 7).Value = "Expenses/Asset Type"
    ws.Cells(1, 8).Value = "Expenses/Asset Description"
    ws.Cells(1, 9).Value = "Starting Date (DD/MMM/YYYY)"
    ws.Cells(1, 10).Value = "Invoice Date (DD/MMM/YYYY)"
    ws.Cells(1, 11).Value = "Aging As Of Today"
End Sub

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
HuaMin ChenProblem resolverAuthor Commented:
Many many thanks Lambert.

I try to adjust the column width by following codes and do not achieve what I need. What to adjust?
Private Sub addHeaders(ByRef ws As Excel.Worksheet)
    ws.Cells(1, 1).Value = "Country"
    ws.Cells(1, 2).Value = "Site Code"
    ws.Cells(1, 3).Value = "LCC"
    ws.Cells(1, 4).Value = "IT Tag No."
    ws.Cells(1, 5).Value = "Record Status"
    ws.Cells(1, 6).Value = "Asset Register Month (MM/YYYY)"
    ws.Cells(1, 7).Value = "Expenses/Asset Type"
    ws.Cells(1, 8).Value = "Expenses/Asset Description"
    ws.Cells(1, 9).Value = "Starting Date (DD/MMM/YYYY)"
    ws.Cells(1, 10).Value = "Invoice Date (DD/MMM/YYYY)"
    ws.Cells(1, 11).Value = "Aging As Of Today"
    With ws.Columns("A")
        If .ColumnWidth * 2 <= 255 Then
            .ColumnWidth = .ColumnWidth * 2
        Else
            .ColumnWidth = 85
        End If
        .ColumnWidth = .ColumnWidth * 2
    End With
    With ws.Columns("B")
        If .ColumnWidth * 2 <= 255 Then
            .ColumnWidth = .ColumnWidth * 2
        Else
            .ColumnWidth = 85
        End If
        .ColumnWidth = .ColumnWidth * 2
    End With
    With ws.Columns("D")
        If .ColumnWidth * 2 <= 255 Then
            .ColumnWidth = .ColumnWidth * 2
        Else
            .ColumnWidth = 85
        End If
        .ColumnWidth = .ColumnWidth * 2
    End With
    With ws.Columns("E")
        If .ColumnWidth * 2 <= 255 Then
            .ColumnWidth = .ColumnWidth * 2
        Else
            .ColumnWidth = 85
        End If
        .ColumnWidth = .ColumnWidth * 2
    End With
    With ws.Columns("F")
        If .ColumnWidth * 2 <= 255 Then
            .ColumnWidth = .ColumnWidth * 2
        Else
            .ColumnWidth = 85
        End If
        .ColumnWidth = .ColumnWidth * 2
    End With
    With ws.Columns("G")
        If .ColumnWidth * 2 <= 255 Then
            .ColumnWidth = .ColumnWidth * 2
        Else
            .ColumnWidth = 85
        End If
        .ColumnWidth = .ColumnWidth * 2
    End With
    With ws.Columns("H")
        If .ColumnWidth * 2 <= 255 Then
            .ColumnWidth = .ColumnWidth * 2
        Else
            .ColumnWidth = 85
        End If
        .ColumnWidth = .ColumnWidth * 2
    End With
    With ws.Columns("I")
        If .ColumnWidth * 2 <= 255 Then
            .ColumnWidth = .ColumnWidth * 2
        Else
            .ColumnWidth = 85
        End If
        .ColumnWidth = .ColumnWidth * 2
    End With
    With ws.Columns("J")
        If .ColumnWidth * 2 <= 255 Then
            .ColumnWidth = .ColumnWidth * 2
        Else
            .ColumnWidth = 85
        End If
        .ColumnWidth = .ColumnWidth * 2
    End With
    With ws.Columns("K")
        If .ColumnWidth * 2 <= 255 Then
            .ColumnWidth = .ColumnWidth * 2
        Else
            .ColumnWidth = 85
        End If
        .ColumnWidth = .ColumnWidth * 2
    End With
    
End Sub

Open in new window

Fabrice LambertConsultingCommented:
First,
By respect to SRP (Single Responsibility Principle), the lines you added should be moved in a separate function or procedure.
The procedure addHeaders() only add headers to your workbook, adjusting columns size is not her job.
(Notice that each function I wrote perform only one task).

Second,
Instead if repeating a bunch of time lines of code that do more or less the same thing, make a function:
Private Sub setColumnWidth(byref column as Excel.range)
    If(column.ColumnWidth * 2 <= 255) Then
        column.ColumnWidth = column.ColumnWidth * 2
    Else
        column.ColumnWidth = 85
    End If
End Sub

Open in new window

Third,
Call the fonction in a loop:
Dim columns As Excel.Range
Set columns = ws.range("A1:K1")

Dim rng As Excel.Range
For Each rng in columns.cells
    setColumnWidth rng.EntireColumn
Next

Open in new window

Fourth,
what do you need to achieve ?
In the getDepartureList function, wouldn't calling wsTrg.Columns("A:K").AutoFit right before saving the workbook perform the job ?
HuaMin ChenProblem resolverAuthor Commented:
Many thanks Lambert.
Where do you put

wsTrg.Columns("A:K").AutoFit

?

The newly created Departure list is not auto. saved by itself and where do we put the line to auto. save it?
Fabrice LambertConsultingCommented:
Where do you put

wsTrg.Columns("A:K").AutoFit
Right bellow the following comments:
'/////////////////////////////////
'// Call a function doing cells formatting here if needed
'/////////////////////////////////
The newly created Departure list is not auto. saved by itself and where do we put the line to auto. save it?
What do you mean here ? I'm not sure to understand.
If the workbook is displayed, it mean it was saved in the first place.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Office

From novice to tech pro — start learning today.