Closing a file newly used in order to only have one ActiveWorkbook

D

Damian37

Active Member
Joined
Jun 9, 2014
Messages
301
Office Version
  1. 365
Hello all,
I'm trying to modify my code in order to close a workbook after it's served its purpose. I've placed the code below. I'm currently receiving a Compile error: Type mismatch. The file I'm opening has "CHARTER_REPLEN" in the name, but it also has a date stamp before the portion of the consistent name "CHARTER_REPLEN" that is always in the name.


Rich (BB code): 
Sub OpenMostRecent()
    Dim fso As FileSystemObject, folder As Object
    Dim wPath As String, wMax As Long, wFile As Variant, wf As Variant
    
    wPath = "C:\Users\DVelez202\Desktop\VBA Code Files"
    
    Set fso = CreateObject("scripting.FileSystemObject")
    Set folder = fso.getfolder(wPath)
    Set wfiles = folder.Files
    wMax = 0
    wFile = ""
    For Each wf In wfiles
        ext = Mid(wf.Name, InStrRev(wf.Name, ".") + 1)
        If LCase(ext) Like "*xlsx*" Then
            If wf.DateLastModified > wMax Then
                wMax = wf.DateLastModified
                wFile = wf.Name
            End If
        End If
   Next
   If wFile <> "" Then Workbooks.Open wFile
End Sub

Sub CopyNeg()
    Dim OldWb As Workbook
    Dim NewWb As Workbook
    Dim NewWs As Worksheet
    Dim CurWs As Worksheet
    Set OldWb = "C:\Users\DVelez202\Desktop\VBA Code Files\_CHARTER_REPLEN"
    Set CurWs = ActiveWorkbook.Worksheets("Replen Report")
    Set NewWb = Workbooks.Add
    Set NewWs = NewWb.Sheets(1)
    CurWs.Range("A:T").AutoFilter Field:=20, Criteria1:="<0"
    CurWs.AutoFilter.Range.EntireRow.Copy
    NewWs.Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
    NewWb.SaveAs "C:\Users\DVelez202\Desktop\VBA Code Files\Negative Replenishment file_" _
    & Format(Date, "mm.dd.yyyy") & ".xlsx", FileFormat:=51
    OldWb.Close
        
    
End Sub

All help is always appreciated.
D.
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
Sort by date Sort by votes
Rich (BB code): 
Sub CopyNeg()
    Dim OldWb As Workbook

    Set OldWb = "C:\Users\DVelez202\Desktop\VBA Code Files\_CHARTER_REPLEN"


You are dimming the variable OldWb as a workbook OBJECT with this line...
Dim OldWb As Workbook


Then assigning that variable a STRING value (NOT AN OBJECT) later on. That will get you a type mismatch 100% of the time.

Set OldWb = "C:\Users\DVelez202\Desktop\VBA Code Files\_CHARTER_REPLEN"


Whats more, is you are using "SET" to assign a string value..SET is only usefor objects.
 
Upvote 0
Steve_ said:
Rich (BB code): 
Sub CopyNeg()
    Dim OldWb As Workbook

    Set OldWb = "C:\Users\DVelez202\Desktop\VBA Code Files\_CHARTER_REPLEN"


You are dimming the variable OldWb as a workbook OBJECT with this line...
Dim OldWb As Workbook


Then assigning that variable a STRING value (NOT AN OBJECT) later on. That will get you a type mismatch 100% of the time.

Set OldWb = "C:\Users\DVelez202\Desktop\VBA Code Files\_CHARTER_REPLEN"


Whats more, is you are using "SET" to assign a string value..SET is only usefor objects.
Click to expand...

Thank you for the clarification. And also to clarify, this isn't a double post. I'm attempting to send multiple emails using a workbook that I've created, however since previous workbooks remain open the code is unable to use the active workbook I want it to use, because there are multiple workbooks open. I'm trying to close this workbook in this post, and it's not allowing me to close the workbook.
 
Upvote 0
Can you show me where you are closing a workbook because I am not able to find that in your code having pointed out the issues with the wb object you created.

Also, are you getting an error? What is happening?
 
Last edited:
Upvote 0
Steve_ said:
Can you show me where you are closing a workbook because I am not able to find that in your code having pointed out the issues with the wb object you created.

Also, are you getting an error? What is happening?
Click to expand...
Hi Steve_,
I'm no longer receiving an error, however, my code for the email portion isn't working and I believe it has to do with the code clearly identifying the workbook I want the code to run on. Here is my entire code:
Rich (BB code): 
Sub Button1_Click()
Call OpenMostRecent
Call CopyNeg
Call Set_Open_ExistingWorkbook
Call vlookup
Call OutlookEmail
End Sub


Sub OpenMostRecent()
    Dim fso As FileSystemObject, folder As Object
    Dim wPath As String, wMax As Long, wFile As Variant, wf As Variant
    
    wPath = "C:\Users\DVelez202\Desktop\VBA Code Files"
    
    Set fso = CreateObject("scripting.FileSystemObject")
    Set folder = fso.getfolder(wPath)
    Set wfiles = folder.Files
    wMax = 0
    wFile = ""
    For Each wf In wfiles
        ext = Mid(wf.Name, InStrRev(wf.Name, ".") + 1)
        If LCase(ext) Like "*xlsx*" Then
            If wf.DateLastModified > wMax Then
                wMax = wf.DateLastModified
                wFile = wf.Name
            End If
        End If
   Next
   If wFile <> "" Then Workbooks.Open wFile
End Sub
Sub CopyNeg()
    Dim OldWb As String
    Dim NewWb As Workbook
    Dim NewWs As Worksheet
    Dim CurWs As Worksheet
    
    OldWb = "C:\Users\DVelez202\Desktop\VBA Code Files\_CHARTER_REPLEN"
    
    Set CurWs = ActiveWorkbook.Worksheets("Replen Report")
    Set NewWb = Workbooks.Add
    Set NewWs = NewWb.Sheets(1)
    CurWs.Range("A:T").AutoFilter Field:=20, Criteria1:="<0"
    CurWs.AutoFilter.Range.EntireRow.Copy
    NewWs.Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
    NewWb.SaveAs "C:\Users\DVelez202\Desktop\VBA Code Files\Negative Replenishment file_" _
    & Format(Date, "mm.dd.yyyy") & ".xlsx", FileFormat:=51
    'OldWb.Close
        
    
End Sub
Sub Set_Open_ExistingWorkbook()
    Dim wkb As Workbook
    Dim wkb2 As Workbook
    
    Set wkb = Workbooks.Open("C:\Users\DVelez202\Desktop\VBA Code Files\Mobile Stores - SMMO Listing.xlsx")
    Set wkb2 = Workbooks.Open("C:\Users\DVelez202\Desktop\VBA Code Files\Negative Replenishment file_" _
    & Format(Date, "mm.dd.yyyy") & ".xlsx")
    wkb.Close
    
End Sub
Sub vlookup()
    Set wkb2 = ActiveWorkbook.Worksheets("Sheet1")
    lastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    wkb2.Range("AE1").Value = "SMMO_NAME"
    ActiveCell.FormulaR1C1 = "SMMO NAME"
    wkb2.Range("AE2:AE" & lastRow).FormulaR1C1 = _
        "=VLOOKUP(VALUE(RC[-30]),'[Mobile Stores - SMMO Listing.xlsx]Sheet1'!C1:C5,4,FALSE)"
    
    wkb2.Range("AF1").Value = "SMMO_EMAIL"
    ActiveCell.FormulaR1C1 = "STORE ID"
    wkb2.Range("AF2:AF" & lastRow).FormulaR1C1 = _
        "=VLOOKUP(VALUE(RC[-31]),'[Mobile Stores - SMMO Listing.xlsx]Sheet1'!C1:C5,5,FALSE)"
End Sub
Sub OutlookEmail()
Dim OutLookApp As Object
  Dim OutLookMailItem As Object
  Dim iCounter As Integer
  Dim MailDest As String
  'Dim MailDest2 As String
  Set OutLookApp = CreateObject("Outlook.application")
  Set OutLookMailItem = OutLookApp.CreateItem(0)

  Worksheets("Sheet1").Activate


  For iCounter = 2 To WorksheetFunction.CountA(Columns(32))

     MailDest = ""
     If Len(Cells(iCounter, 1).Offset(0, -0)) > 0 Then
     If MailDest = "" And Cells(iCounter, 20).Offset(0, -1) < 0 Then
     Set OutLookMailItem = OutLookApp.CreateItem(0)
     With OutLookMailItem
     MailDest = Cells(iCounter, 32).Value
     'MailDest2 = Cells(iCounter, 31).Value
        .To = MailDest
        .CC = "Davon_Johnston@cable.comcast.com"
        .CC = "Casey_Montgomery@cable.comcast"
        .CC = "Damian_Velez@cable.comcast.com"
        .Subject = "Negative Replenishment"
        .HTMLBody = "Hello, & MailDest<p>" _
            & "Your store(s) is/are reporting negative inventory on one or more SKUs. " _
            & "The SKUs that have negative counts will impact replenishment of that particular SKU(s). " _
            & "Please cycle count the below SKU(s) and enter the corrected on hand quantity into the system to prevent further impact to replenishment. " _
            & "Please remember a negative inventory count on 1 SKU will stop replenishment on that 1 SKU, " _
            & "more than 5 negative inventory counts on devices will impact all device replenishment, " _
            & "and more than 20 negatives on accessories will impact replenishment on all accessories until counts are corrected. " _
            & "If you are having an issue correcting your negative inventory please open a Service Now ticket for xStore issues." _
            & "For inventory related issues, please open a ticket in Spice Works for the Supply Chain Support Desk (SCSD).<p>" _
            & "Thank You,<p>" & "Davon Johnston<br>" _
            & "<font color=""red"">Manager, Supply Chain Support, Strategic Development<br>[/font]" _
            & "Cell #: 720-357-0303<br>" _
            & "Desk #: 303-658-7803"
            .Attachments.Add ActiveWorkbook.wkb2
    .Display
    '.Send
    End With
        End If
   End If
    Next iCounter
  Set OutLookMailItem = Nothing
  Set OutLookApp = Nothing
End Sub
I've bolded and colored the line I believe needs to be corrected. Thank you!
D.
 
Upvote 0
Seems you can test that by fully qualifying your objects...for example:

Instead of using Cells(iCounter, 32).Value


use:
ThisWorkbook.Sheets("SHEET_NAME").Cells(iCounter, 32).Value


So in your case, your "RED" line would need to be changed to...

ThisWorkbook.Sheets("Sheet1").Activate
 
Last edited:
Upvote 0
Steve_ said:
Seems you can test that by fully qualifying your objects...for example:

Instead of using Cells(iCounter, 32).Value


use:
ThisWorkbook.Sheets("SHEET_NAME").Cells(iCounter, 32).Value


So in your case, your "RED" line would need to be changed to...

ThisWorkbook.Sheets("Sheet1").Activate
Click to expand...

I appreciate the suggestions. I've tried to implement those suggestions, but I still believe, because there are more than 1 active workbooks, the code doesn't know which workbook to use.
 
Upvote 0
Steve_ said:
Seems you can test that by fully qualifying your objects...for example:

Instead of using Cells(iCounter, 32).Value


use:
ThisWorkbook.Sheets("SHEET_NAME").Cells(iCounter, 32).Value


So in your case, your "RED" line would need to be changed to...

ThisWorkbook.Sheets("Sheet1").Activate
Click to expand...

Hi Steve_,
I think my issue might have to do with the email addresses are still showing the vlookup formula. So now I am trying to copy the new columns I've added to my newly created file, however, I'm getting a Run-Time error '1004': Application-defined or object-defined error. Here's my code:
Rich (BB code): 
Sub vlookup()

    Set wkb2 = ActiveWorkbook.Worksheets("Sheet1")
    lastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    wkb2.Range("AE1").Value = "SMMO_NAME"
    ActiveCell.FormulaR1C1 = "SMMO NAME"
    wkb2.Range("AE2:AE" & lastRow).FormulaR1C1 = _
        "=VLOOKUP(VALUE(RC[-30]),'[Mobile Stores - SMMO Listing.xlsx]Sheet1'!C1:C5,4,FALSE)"
    
    wkb2.Range("AF1").Value = "SMMO_EMAIL"
    ActiveCell.FormulaR1C1 = "STORE ID"
    wkb2.Range("AF2:AF" & lastRow).FormulaR1C1 = _
        "=VLOOKUP(VALUE(RC[-31]),'[Mobile Stores - SMMO Listing.xlsx]Sheet1'!C1:C5,5,FALSE)"
    
    wkb2.Range("AE2:AE" & lRow).Copy
    wkb2.Range("AE" & lastRow).Paste
    wkb2.Range("AF2:AF" & lRow).Copy
    wkb2.Range("AF" & lastRow).Paste
    Application.CutCopyMode = False
    

End Sub
The line I have in bold red is where I'm getting the error. Thank you very much for your help. I really appreciate it.
D.
 
Upvote 0
Damian37 said:
Hi Steve_,
I think my issue might have to do with the email addresses are still showing the vlookup formula. So now I am trying to copy the new columns I've added to my newly created file, however, I'm getting a Run-Time error '1004': Application-defined or object-defined error. Here's my code:
Rich (BB code): 
Sub vlookup()

    Set wkb2 = ActiveWorkbook.Worksheets("Sheet1")
    lastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    wkb2.Range("AE1").Value = "SMMO_NAME"
    ActiveCell.FormulaR1C1 = "SMMO NAME"
    wkb2.Range("AE2:AE" & lastRow).FormulaR1C1 = _
        "=VLOOKUP(VALUE(RC[-30]),'[Mobile Stores - SMMO Listing.xlsx]Sheet1'!C1:C5,4,FALSE)"
    
    wkb2.Range("AF1").Value = "SMMO_EMAIL"
    ActiveCell.FormulaR1C1 = "STORE ID"
    wkb2.Range("AF2:AF" & lastRow).FormulaR1C1 = _
        "=VLOOKUP(VALUE(RC[-31]),'[Mobile Stores - SMMO Listing.xlsx]Sheet1'!C1:C5,5,FALSE)"
    
    wkb2.Range("AE2:AE" & lRow).Copy
    wkb2.Range("AE" & lastRow).Paste
    wkb2.Range("AF2:AF" & lRow).Copy
    wkb2.Range("AF" & lastRow).Paste
    Application.CutCopyMode = False
    

End Sub
The line I have in bold red is where I'm getting the error. Thank you very much for your help. I really appreciate it.
D.
Click to expand...
Hi Steve_,
I figured out my copying and pasting issues. Thanks.
D.
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Question Question
Saving workbook on shared drive that may have different letter assignments
Replies
3
Views
649
Fluff
Fluff
D
  • Question Question
VBA code to autosave a file with current date for the name of file
Replies
1
Views
467
JoeMo
J

Forum statistics

Threads
1,223,236
Messages
6,170,915
Members
452,366
Latest member
TePunaBloke

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top