Macro has to run twice to work.

[spd0lit]

Hello,
I'm having an issue where i need to run my macro twice in order for the code to recognize newly added Microsoft Excel objects. I have an excel file with just one sheet with some cells to populate. I have a subroutine that opens new files and puts each file as a new worksheet with the file name as the worksheet name. When i try to run the second sub routine that takes information from the two new files added, the debugger opens saying object not defined. Now, if i close the debugger and run the second sub routine again it will run fine. Is there a way to refresh the recognized objects before running the second sub routine?

Thanks

 

[spd0lit]

Here is some of the code if that helps:

Option Explicit

Sub CopyWorksheets2()

Dim filenames As Variant
Dim strActiveBook As String
Dim strSourceDataFile As String
Dim wSht As Worksheet, wSht2 As Worksheet
Dim allwShts As Sheets, allwShts2 As Sheets
Dim SheetName As String
Dim counter As Integer, intResponse As Integer

Application.DisplayAlerts = False
intResponse = MsgBox("This macro will copy all worksheets from selected files to the current workbook. Continue?", vbOKCancel, "Copy Worksheets to Current File")
If intResponse = vbOK Then
strActiveBook = ActiveWorkbook.Name

' Create array of filenames; the True is for multi-select
filenames = Application.GetOpenFilename("All Files (*.*),*.*", , , , True)
If TypeName(filenames) = "Boolean" Then Exit Sub

counter = 1

' ubound determines how many items in the array
On Error GoTo quit

intResponse = MsgBox("Retain Original Worksheet Names? (If No, then each copied worksheet will be given the name of the Excel file from which it came).", vbYesNo, "Copy Worksheets")
Application.ScreenUpdating = False
If intResponse = vbNo Then
While counter <= UBound(filenames)

'Opens the selected files
Workbooks.Open filenames(counter)
strSourceDataFile = ActiveWorkbook.Name
If strSourceDataFile <> strActiveBook Then
'Copy all worksheets except "Specifications"
Set allwShts = Worksheets
For Each wSht In allwShts
Workbooks(strSourceDataFile).Activate
If UCase(wSht.Name) <> "SPECIFICATIONS" Then
If wSht.Visible = True Then
Sheets(wSht.Name).Select
Sheets(wSht.Name).Copy before:= _
Workbooks(strActiveBook).Sheets(1)
SheetName = Left(strSourceDataFile, Len(strSourceDataFile) - 4)
Workbooks(strActiveBook).Activate
'Check to see if a Sheet already has the name
If SheetExists(SheetName) = True Then
ActiveSheet.Name = Left(strSourceDataFile, Len(strSourceDataFile) - 4) & "(" & wSht.Index & ")"
Else
ActiveSheet.Name = Left(strSourceDataFile, Len(strSourceDataFile) - 4)
End If
End If
End If
Next wSht
Workbooks(strSourceDataFile).Activate
ActiveWorkbook.Close

' displays file name in a message box
MsgBox strSourceDataFile & " Has Been Processed", vbOKOnly + vbInformation, "File Processed"
End If
'increment counter
counter = counter + 1
Wend
Else
While counter <= UBound(filenames)
'Opens the selected files
Workbooks.Open filenames(counter)
strSourceDataFile = ActiveWorkbook.Name
If strSourceDataFile <> strActiveBook Then
'Copy all worksheets except "Specifications"
Set allwShts = Worksheets
For Each wSht In allwShts
If wSht.Visible = True Then
Workbooks(strSourceDataFile).Activate
Sheets(wSht.Name).Select
Sheets(wSht.Name).Copy before:= _
Workbooks(strActiveBook).Sheets(1)
End If
Next wSht
Workbooks(strSourceDataFile).Activate
ActiveWorkbook.Close

' displays file name in a message box
'MsgBox strSourceDataFile & " Has Been Processed", vbOKOnly + vbInformation, "File Processed"
End If
'increment counter
counter = counter + 1
Wend
End If

quit:
If Err <> 0 Then
MsgBox "An Error Occurred Trying to open the File. Please close any open Excel files and try again", vbOKOnly + vbExclamation, "File Open Error"
On Error GoTo 0
End If
End If
Set allwShts = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True



End Sub
Private Function SheetExists(sname) As Boolean
' Returns TRUE if sheet exists in the active workbook
Dim x As Object
On Error Resume Next
Set x = ActiveWorkbook.Sheets(sname)
If Err = 0 Then SheetExists = True _
Else SheetExists = False
On Error GoTo 0
End Function
Sub Report_Populate()

'Time Format
With Sheet2
.Activate
'Converts 1hz hhmmss to hh:mm:ss
Dim LastRow As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A4:A" & LastRow) = Evaluate("IF(ROW(),0+TEXT(SUBSTITUTE(A4:A" & LastRow & ","" "",""""),""00\:00\:00""))")
Range("A4:A" & LastRow).NumberFormat = "hh:mm:ss"
End With

'Format Test Date
With Sheet3
.Activate
Dim l As Long
Dim s As String
Dim d As Date

l = Range("KB13").Value

' convert it to a string
s = CStr(l)

' can now use string functions to parse it
d = DateSerial(CInt(Left(s, 4)), CInt(Mid(s, 5, 2)), CInt(Right(s, 2)))
' d is now 29 Feb 2012

' write it back to the sheet
Sheet1.Cells(24, 3) = d
End With


End Sub