VBA other Workbook Doesnt close Properly - vba

Hi there My VBA code does not want to close my Raw data File properly.
I have a data capture form then , When I hit Submit, Opens another Excel File, Copies all the data into it and is supposed to save and close the workbook.
My code is as follows:
Private Sub submit_Click()
'Open Workbook
If MsgBox("You are about to Submit, Are you sure?" & vbCr & "Please make sure that the OUTCOME box is complete", vbYesNo) = vbNo Then Exit Sub
Dim wb As Workbook, sh As Worksheet
Set wkb = Workbooks.Open("\\ServerName\Reports Folder\Team Name\Manager Name\RAW\RAW QC data.xlsx")
'Make Daily_Tracking_Dataset active
'Determine emptyRow
'Transfer Information
Set wb = Workbooks("RAW QC data.xlsx")
Set sh = wb.Sheets(1)
cAry = Array(Me.QCBX, Me.CallBX, Me.INBX, Me.AgntBX, Me.VoxBX, Me.ClntBX, Me.PolBX, Me.DateBX1, Me.AuditBX1, Me.TextBox7, Me.TextBox8, Me.OUTBX1, Me.Cbx1_1, Me.Cbx1_2, Me.Cbx1_3, Me.Cbx1_4, Me.OUTBX2, Me.Cbx2_1, Me.Cbx2_2, Me.Cbx2_3, Me.OUTBX3, Me.Cbx3_1, Me.Cbx3_2, Me.OUTBX4, Me.Cbx4_1, Me.Cbx4_2, Me.Cbx4_3, Me.OUTBX5, Me.Cbx5_1, Me.Cbx5_2, Me.Cbx5_3, Me.Cbx5_4, Me.Cbx5_5, Me.Cbx5_6, Me.Cbx5_7, Me.Cbx5_8, Me.ACBX, Me.QTBX, Me.QFBX)
With sh
For i = 1 To 39
.Cells(Rows.Count, i).End(xlUp)(2) = cAry(i - 1).Value
Next
End With
'Save the Raw data
wb.Close SaveChanges:=True
End Sub
What is happening is that it looks like it is working but when I try to submit the next one, It gives me the SAVE AS window

You have both wkb and wb in your code. Probably this is not what you intend. Just try changing wkb to wb in your code. That's a good reason to start using Option Explicit - What do Option Strict and Option Explicit do?
In general, something as simple as this should be working:
Public Sub TestMe()
'Dim wb As Workbook
Dim wkb As Workbook
Dim sh As Worksheet
Set wkb = Workbooks.Open(ThisWorkbook.Path & "\Testing.xlsx")
'Set wb = Workbooks("Testing.xlsx")
'Put your loop instead of the TEST later:
wb.Worksheets(1).Cells(1, 1) = "TEST"
Application.DisplayAlerts = False
wkb.Save
Application.DisplayAlerts = True
wkb.Close
End Sub

Related

What code to use in copying the workbook, removing all macros (including form controls), and pasting to another New Workbook w/o removing formula?

I created a workbook that is automated with macro and I want to copy the whole workbook and paste it into another workbook and remove all macro's (including the form controls) except only the formulas.
My code is working copying the workbook and pasting to another workbook (including the formulas) and removing the macros. But the Form controls were still keep on appearing in the new workbook. What code do I need to add? Please help me. My code is written below:
Private Sub Label16_Click()
Unload Me
Dim NewWkb As Workbook
Dim xWkb As Workbook
Dim x As Integer
Set xWkb = Workbooks("Technical Support Database (Automated by MACRO).xlsb")
Set NewWkb = Workbooks.Add
NewWkb.SaveAs "C:\Users\TSJeddah\OneDrive - Delta Marketing Co\JIM FILES\Operation Files\" & "TS Database (No MACRO).xlsx"
For x = 1 To xWkb.Worksheets.Count - 1
xWkb.Sheets(x).Copy after:=NewWkb.Worksheets(NewWkb.Worksheets.Count)
Next x
End Sub
If you need to remove all form controls from the target workbook, you can do so with the following code:
Sub DeleteFormControlsFromWB(WB As Workbook)
Dim sh As Shape, ws As Worksheet
For Each ws In WB.Worksheets
For Each sh In ws.Shapes
If sh.Type = msoFormControl Or sh.Type = msoOLEControlObject Then
Debug.Print "Deleted Form control: " & sh.Name 'debug
sh.Delete
End If
Next
Next
End Sub
Sub UsageExample()
DeleteFormControlsFromWB ThisWorkbook
End Sub
Private Sub Label16_Click()
Unload Me
Dim NewWkb As Workbook
Dim xWkb As Workbook
Dim x As Integer
Set xWkb = Workbooks("Technical Support Database (Automated by
MACRO).xlsb")
Set NewWkb = Workbooks.Add
NewWkb.SaveAs "C:\Users\TSJeddah\Desktop\JIM\" & "TS Database (No
MACRO).xlsx"
Call UsageExample
For x = 1 To xWkb.Worksheets.Count - 1
xWkb.Sheets(x).Copy
after:=NewWkb.Worksheets(NewWkb.Worksheets.Count)
Next x
ActiveWorkbook.Close
Application.ScreenUpdating = True
End Sub

Stay in the active workbook after opening other workbooks

I am trying to open two other Excel workbooks to take data to do my calculation through the macro. I have a working code to open those files.
Dim wbCount As Integer
Application.ScreenUpdating = False
For wbCount = 1 To 2
Workbooks.Open Filename:=ThisWorkbook.Path & "\Installation Sheet " & wbCount & ".xlsm", UpdateLinks:=False
Next wbCount
ThisWorkbook.Activate
Application.ScreenUpdating = True
The other files are named "Installation Sheet 1" and "Installation Sheet 2". After this code runs, I end up with "Installation Sheet 1" displaying instead of my active workbook.
Put your ActiveWorkbook into a variable at the appropriate place and then use that to move back. ThisWorkbook is the one with code in. So be sure if you mean ActiveWorkbook or ThisWorkbook, or if ThisWorkbook is the ActiveWorkbook at the time. In that case, you can simply Set wb = ThisWorkbook
Dim wb As Workbook
Set wb = ActiveWorkbook
'Set wb = ThisWorkbook '<== If you want the workbook containing the code
'Other code
wb.Activate
You have to put your workbooks references into variables and then using these variables you have two options: close newly opened workbook, so only original stays opened or use Activate method to bring the original workbook to front.
Sample code:
Sub OpeningWb()
Dim wb As Workbook, currentWb As Workbook
Set currentWb = ThisWorkbook
Set wb = Workbooks.Open("your path here")
' if you want to close opened workbook
'wb.Close
' if you want to bring to front original workbook
currentWb.Activate
End Sub
Alternatively, you can do the following:
Dim wbToDisplay As Workbook
Set wbToDisdplay = Workbooks("workbook name here")
wbToDisplay.Activate
The above solutions didn't work for me, because activate method is fired before second workbook is displayed, so I get active this second workbook always. My workaround is wait a couple of seconds before calling Activate method:
Dim t: t = Timer
While Timer < t + 2 'wait for 2 seconds
DoEvents
Wend
ThisWorkbook.Activate

Deactivate entire sheet selection after paste

I recently asked a question and received a great answer on this site, but I am now running into a different problem. The code below works well for running through each workbook in a folder, copying a sheet's contents, and pasting those contents into a master workbook exactly how I would like:
Sub ConslidateWorkbooks()
'Code to pull sheets from multiple Excel files in one file directory
'into master "Consolidation" sheet.
Dim FolderPath As String
Dim Filename As String
Dim Sheet As Worksheet
Dim wbName As String
With ActiveSheet
Range("A1").Activate
End With
Application.ScreenUpdating = False
FolderPath = ActiveWorkbook.Path & "\"
Filename = Dir(FolderPath & "*.xls*")
wbName = ActiveWorkbook.Name
Do While Filename <> ""
If Filename <> wbName Then
Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
copyOrRefreshSheet ThisWorkbook, Sheet
Next Sheet
Workbooks(Filename).Saved = True
Workbooks(Filename).Close
ActiveSheet.Range("A1").Activate
End If
Filename = Dir()
Loop
Application.ScreenUpdating = True
End Sub
Sub copyOrRefreshSheet(destWb As Workbook, sourceWs As Worksheet)
Dim ws As Worksheet
On Error Resume Next
Set ws = destWb.Worksheets(sourceWs.Name)
On Error GoTo 0
If ws Is Nothing Then
sourceWs.Copy After:=destWb.Worksheets(destWb.Worksheets.Count)
Else
ws.Unprotect Password:="abc123"
ws.Cells.ClearContents
sourceWs.UsedRange.Copy
ws.Range(sourceWs.UsedRange.Address).PasteSpecial (xlPasteAll)
Application.CutCopyMode = False
End If
End Sub
The problem I am having now: After the paste is completed, each sheet in the master workbook has all of its cells selected, as though I Ctrl+A'd the entire sheet. I would like to get rid of this. It is a small task which I tried to accomplish in the line ActiveSheet.Range("A1").Activate within the Do While .. loop, but it has not worked for me.
EDIT:
I found a solution that works in this case. I am not sure why this was necessary, because the comments and answers in this thread seem like they should work, but they did not. I call this sub before I turn screenupdating to True in the main sub:
Sub selectA1()
Worksheets(1).Activate
Dim Sheet As Worksheet
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Activate
ActiveWindow.ScrollRow = 1
ActiveWindow.ScrollColumn = 1
Sheet.Range("A1").Select
Next Sheet
Worksheets(1).Activate
End Sub
I realize this is more complicated than it should be, but it works for my purposes.
In your copy sub, add in another code in the loop that will select a cell which should deactivate the total used range selection and just select the coded range.
Sub copyOrRefreshSheet(destWb As Workbook, sourceWs As Worksheet)
Dim ws As Worksheet
On Error Resume Next
Set ws = destWb.Worksheets(sourceWs.Name)
On Error GoTo 0
If ws Is Nothing Then
sourceWs.Copy After:=destWb.Worksheets(destWb.Worksheets.Count)
Else
ws.Unprotect Password:="abc123"
ws.Cells.ClearContents
sourceWs.UsedRange.Copy
ws.Range(sourceWs.UsedRange.Address).PasteSpecial (xlPasteAll)
ws.range("A1").select
Application.CutCopyMode = False
End If
End Sub
I added ws.range("A1").select which should do as I described above.

Workbooks.open return before focus (Excel 2010 and 2016)

I have a macro that opens a new Workbook and then activate (focus) to first Workbook.
Code:
Set mainWorkbook = ActiveWorkbook
Set bdWorkbook = Workbooks.Open(FileName:="Another.xlsm", ReadOnly:=True)
mainWorkbook.Activate
I've got this code working in Excel 2007, but I've encountered an issue with the open workbook in Excel 2010 and later. The problem happens because Workbooks.Open returns to VBA before Excel Activate the new workbook [it works fine using debugger].
I can make an workarround using a Application.Wait (Now + TimeValue("0:00:01")), but......
EDIT: My code that dosen't work in Excel 2016
Sub Sample()
Dim path As String
path = "A_PATH_FROM_MY_SERVER"
actualScreenUpdate = Application.ScreenUpdating
Application.ScreenUpdating = False
Set MainWB = ActiveWorkbook
Workbooks.Open fileName:=path, UpdateLinks:=False, ReadOnly:=isReadOnly
Set bdWB = ActiveWorkbook
DoEvents
MainWB.Activate
Application.ScreenUpdating = actualScreenUpdate
With Sheets(MY_BD_SHEET)
bdWB.ActiveSheet.UsedRange.Copy .[A1]
'....
End With
End Sub
Is this what you want? (Tried And Tested)
This will open the relevant workbook and minimize it thereby returning focus to your main workbook.
Sub Sample()
Dim wbThis As Workbook, wbThat As Workbook
Set wbThis = ThisWorkbook
Set wbThat = Workbooks.Open("C:\Users\Siddharth\Desktop\Sample.xlsx")
DoEvents
Application.WindowState = xlMinimized
' OR
ActiveWindow.WindowState = xlMinimized
End Sub
EDIT
After seeing your current Edit.
MainWB.Activate
Application.ScreenUpdating = actualScreenUpdate
You are activating when the ScreenUpdating = False? Set it to True and then Activate it :)

Run macro on all files open in taskbar one by one

My work is regarding formating 100 of files everyday. though i have a macro desined for the purpose but i have to run the macro on each and every file one after saving previous.
my question is how can i be able to run my macro on these opened workbooks in one step. As i save one it would run on other one in the queue.
Put the following macro in a "BASE" workbook as Passerby mentioned
Sub SO()
Dim macroList As Object
Dim workbookName As String
Dim wbFullPath
Dim macroName As String
Dim currentWb As Workbook
Dim masterWb As Workbook ' the Excel file you are calling this procedure from
Dim useWbList As Boolean
Dim height As Long, i As Long
Dim dataArray As Variant
useWbList = False ' DEFINE which input method
Set macroList = CreateObject("Scripting.Dictionary")
If useWbList Then
' you can also from the dictionary from 2 columns of an excel file , probably better for management
With masterWb.Worksheets("Sheet1") '<~~ change Sheet1 to the sheet name storing the data
height = .Cells(.Rows.Count, 1).End(xlUp).Row ' Assume data in column A,B, starting from row 1
If height > 1 Then
ReDim dataArray(1 To height, 1 To 2)
dataArray = .Range(.Cells(1, 1), .Cells(height, 2)).Value
For i = 1 To height
macroList.Add dataArray(i, 1), dataArray(i, 2)
Next i
Else
'height = 1 case
macroList.Add .Cells(1, 1).Value, .Cells(1, 2).Value
End If
End With
Else
' ENTER THE FULl PATH in 1st agrument below, Macro Name in 2nd argument
' Remember to make sure the macro is PUBLIC, try to put them in Module inside of Sheets'
macroList.Add "C:\Users\wangCL\Desktop\Book1.xlsm", "ThisWorkbook.testing"
'macroList.Add "FULL PATH", "MACRO NAME"
'macroList.Add "FULL PATH", "MACRO NAME"
'macroList.Add "FULL PATH", "MACRO NAME"
End If
Application.DisplayAlerts = False
For Each wbFullPath In macroList.keys
On Error GoTo 0
macroName = macroList.Item(workbookName)
workbookName = Mid(wbFullPath, InStrRev(wbFullPath, "\") + 1)
Err.Clear
On Error Resume Next
Set currentWb = Nothing
Set currentWb = Workbooks(workbookName) ' see if the workbook is already open
If Err.Number <> 0 Then
' open the workbook if workbook NOT opened
Set currentWb = Workbooks.Open(workbookName, ReadOnly:=True)
End If
On Error GoTo 0
' run the macro
Application.Run workbookName & "!" & macroList.Item(wbFullPath)
'close the workbook after running the macro
currentWb.Close saveChanges:=False
Set currentWb = Nothing
Next wbFullPath
End Sub
Hope it helps and please let me know if there's anything unclear
I have got my solve using below code.
Sub OpenAllWorkbooksnew()
Set destWB = ActiveWorkbook
Dim DestCell As Range
Dim cwb As Workbook
For Each cwb In Workbooks
**Call donemovementReport**
ActiveWorkbook.Close True
ActiveWorkbook.Close False
Next cwb
End Sub