J
Jin
I need a help with the below procedure, I get a Type Mismatch Error when the
code reaches the datevalue. Please help.
Thanks,
Jin
Sub Consolidate()
Dim BaseBook As Workbook
Dim i As Integer
Dim j As Integer
With Application.FileSearch
.NewSearch
.LookIn = "C:\SALES"
.SearchSubFolders = True
myStoreString = InputBox("Store Number?")
.Filename = "***" & myStoreString & "**"
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
Set BaseBook = Workbooks.Open(.FoundFiles(1), UpdateLinks:=0)
BaseBook.Worksheets(1).Name = Left(BaseBook.Name, 3)
For i = 2 To .FoundFiles.Count
Set myBook = Workbooks.Open(.FoundFiles(i), UpdateLinks:=0)
myFilename = myBook.Name
myBook.Worksheets(1).Move After:=BaseBook.Sheets(i - 1)
ActiveSheet.Name = Left(myFilename, 3)
Next i
For j = 1 To BaseBook.Worksheets.Count
For i = j To BaseBook.Worksheets.Count
If DateValue(Worksheets(i).Name & " 3, 2003") < _
DateValue(Worksheets(j).Name & "3, 2003") Then
Worksheets(i).Move Before:=Worksheets(j)
End If
Next i
Next j
BaseBook.SaveAs Application.GetSaveAsFilename _
("CA" & myStoreString & "sls03" & ".xls")
End If
End With
End Sub
code reaches the datevalue. Please help.
Thanks,
Jin
Sub Consolidate()
Dim BaseBook As Workbook
Dim i As Integer
Dim j As Integer
With Application.FileSearch
.NewSearch
.LookIn = "C:\SALES"
.SearchSubFolders = True
myStoreString = InputBox("Store Number?")
.Filename = "***" & myStoreString & "**"
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
Set BaseBook = Workbooks.Open(.FoundFiles(1), UpdateLinks:=0)
BaseBook.Worksheets(1).Name = Left(BaseBook.Name, 3)
For i = 2 To .FoundFiles.Count
Set myBook = Workbooks.Open(.FoundFiles(i), UpdateLinks:=0)
myFilename = myBook.Name
myBook.Worksheets(1).Move After:=BaseBook.Sheets(i - 1)
ActiveSheet.Name = Left(myFilename, 3)
Next i
For j = 1 To BaseBook.Worksheets.Count
For i = j To BaseBook.Worksheets.Count
If DateValue(Worksheets(i).Name & " 3, 2003") < _
DateValue(Worksheets(j).Name & "3, 2003") Then
Worksheets(i).Move Before:=Worksheets(j)
End If
Next i
Next j
BaseBook.SaveAs Application.GetSaveAsFilename _
("CA" & myStoreString & "sls03" & ".xls")
End If
End With
End Sub