You are here:

Excel/Run complete macro sequentially

Advertisement


Question
Dear Tom,
I built a macro to do following:
1- create sheets based on cells value.
2- calculate each sheet by using (Sendkeys)function since the new copied sheets is linked to reporting software get update its data when we press (Alt+ Ctrl +s) together.
3- after finish calculate each sheet macro should copy each resulted sheet to a separate workbook and save it as value only.

Macro was :

Dim mysht As Worksheet
Set mysht = Worksheets("Main")
Dim n As Long
n = 9
While Len(mysht.Cells(n, 1).Value) > 0
   Worksheets("BVA").Copy After:=Worksheets("Main")
   ActiveSheet.Name = mysht.Cells(n, 2).Value
   ActiveSheet.Range("C4").NumberFormat = "@"
   ActiveSheet.Range("C4").Value = ActiveSheet.Name
   n = n + 1
Wend

Dim WS_Count As Integer
WS_Count = ActiveWorkbook.Worksheets.Count
For i = 3 To WS_Count

Worksheets(i).Activate
SendKeys "^%s"
 
Next i




Dim FileExtStr As String
   Dim FileFormatNum As Long
   Dim Sourcewb As Workbook
   Dim Destwb As Workbook
   Dim sh As Worksheet
   Dim DateString As String
   Dim FolderName As String

   With Application
       .ScreenUpdating = False
       .EnableEvents = False
       .Calculation = xlCalculationManual
   End With

   'Copy every sheet from the workbook with this macro
   Set Sourcewb = ThisWorkbook

   'Create new folder to save the new files in
   DateString = Format(Now, "yyyy-mm-dd hh-mm-ss")
   FolderName = Sourcewb.Path & "\" & Sourcewb.Name & " " & DateString
   MkDir FolderName

   'Copy every visible sheet to a new workbook
   For Each sh In Sourcewb.Worksheets

       'If the sheet is visible then copy it to a new workbook
       If sh.Visible = -1 Then
         sh.Copy

         'Set Destwb to the new workbook
         Set Destwb = ActiveWorkbook

         'Determine the Excel version and file extension/format
         With Destwb
         If Val(Application.Version) < 12 Then
         'You use Excel 97-2003
         FileExtStr = ".xls": FileFormatNum = -4143
         Else
         'You use Excel 2007-2013
         If Sourcewb.Name = .Name Then
         MsgBox "Your answer is NO in the security dialog"
         GoTo GoToNextSheet
         Else
         Select Case Sourcewb.FileFormat
         Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
         Case 52:
         If .HasVBProject Then
         FileExtStr = ".xlsm": FileFormatNum = 52
         Else
         FileExtStr = ".xlsx": FileFormatNum = 51
         End If
         Case 56: FileExtStr = ".xls": FileFormatNum = 56
         Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
         End Select
         End If
         End If
         End With

         'Change all cells in the worksheet to values if you want
         If Destwb.Sheets(1).ProtectContents = False Then
         With Destwb.Sheets(1).UsedRange
         .Cells.Copy
         .Cells.PasteSpecial xlPasteValues
         .Cells(1).Select
         End With
         Application.CutCopyMode = False
         End If


         'Save the new workbook and close it
         With Destwb
         .SaveAs FolderName _
         & "\" & Destwb.Sheets(1).Name & FileExtStr, _
         FileFormat:=FileFormatNum
         .Close False
         End With

       End If
GoToNextSheet:
   Next sh

   MsgBox "You can find the files in " & FolderName

   With Application
       .ScreenUpdating = True
       .EnableEvents = True
       .Calculation = xlCalculationAutomatic
   End With

Problem was:
1- creating sheets within the original workbook done perfectly.
2- (Sendkeys"^%s") was work for one sheet only. and not calculating other created sheets.
3- functions to save all resulted sheets into individuals new workbooks done perfectly, But this also should Done after finish step 2 which is (calculating all sheets by using Sendkeys).

Kindly advice.

Thanks

Answer
Mahmoud

Try using the wait command in sendkeys

I also suggest putting doevents on each side of the sendkeys command

Dim WS_Count As Integer
WS_Count = ActiveWorkbook.Worksheets.Count
For i = 3 To WS_Count

Worksheets(i).Activate
doevents          '<== added doevents command
SendKeys "^%s", True    '<== added Wait argument set to True here
doevents          '<== added doevents command
 
Next i


That is assuming that you must use Sendkeys to get your data to update.  I have no idea what your sheet is doing but you talk about a third party application.

You could try using  

Application.CalculateFull

or

application.CalculateFullRebuild

and see if that will update your workbook.  That would replace your whole loop structure above if it does work and would be more reliable than sendkeys

--
Regards,
Tom Ogilvy  
About Excel
This topic answers questions related to Microsoft Excel spreadsheet (or workbook) stand-alone or Mircrosoft Office Excel including Excel 2003, Excel 2007, Office 2000, and Office XP. You can get Excel help on Excel formulas(or functions), Excell macros, charting in Excel, advanced features, and the general use of Excel. This does not provide a general Excel tutorial nor the basics of using a spreadsheet. It provides specific answers to using Microsoft Excel only. If you do not see your Excel question answered in this area then please ask an Excel question here

Excel

All Answers


Answers by Expert:


Ask Experts

Volunteer


Tom Ogilvy

Expertise

Selected as an Excel MVP by Microsoft since 1999. Answering Excel questions in Allexperts since its inception in 2001. Able to answer questions on almost all aspects of Excel's internal capabilities. If seeking a VBA solution, please specify that in your question itself so I give you the answer you want. [Excel has weak protection - if you are distributing an application, I don't answer questions on how to protect your project from your users.]

Experience

Extensive experience.

Education/Credentials
Master of Science (MS) degree Operations Research (ORSA)

Awards and Honors
Microsoft MVP in Excel.

©2016 About.com. All rights reserved.