Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Why won't this code run??
I'm trying to loop thru all workbooks in a folder and copy the left 6 digits
of the file name from A1 to the last row with data. When I run the code it stops on the first workbook and does nothing??? Here's the code: Option Explicit Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function Sub PrepFiles() Dim basebook As Workbook Dim mybook As Workbook Dim facility As Long Dim destrange As Range Dim FNames As String Dim MyPath As String Dim SaveDriveDir As String Dim Lr As Long SaveDriveDir = CurDir MyPath = "E:\Ron Hoffman\Inpatient\Test\2003 Credit Balances" If Right(MyPath, 1) < "\" Then MyPath = MyPath & "\" End If ChDrive MyPath ChDir MyPath FNames = Dir("*.xls") If Len(FNames) = 0 Then MsgBox "No files in the Directory" ChDrive SaveDriveDir ChDir SaveDriveDir Exit Sub End If On Error GoTo CleanUp Application.ScreenUpdating = False Application.EnableEvents = False Do While FNames < "" Set mybook = Workbooks.Open(FNames, UpdateLinks:=0) facility = Left(mybook, 6) Lr = LastRow(Sheets("Credit Detail")) Sheets("Credit Detail").Range("A1:A" & Lr).Value = facility mybook.Close True FNames = Dir() Loop CleanUp: ChDrive SaveDriveDir ChDir SaveDriveDir Application.ScreenUpdating = True Application.EnableEvents = True End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Why won't this code run??
There will be a problem if your find function does not find anything. When
that happens the function returns empty, which your long variable Lr converts to a zero. On the next line you refernce A1:A0 which is an invalid range... That is one issue that needs to be fixed... Lr = LastRow(Sheets("Credit Detail")) Sheets("Credit Detail").Range("A1:A" & Lr).Value = facility HTH "TEB2" wrote: I'm trying to loop thru all workbooks in a folder and copy the left 6 digits of the file name from A1 to the last row with data. When I run the code it stops on the first workbook and does nothing??? Here's the code: Option Explicit Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function Sub PrepFiles() Dim basebook As Workbook Dim mybook As Workbook Dim facility As Long Dim destrange As Range Dim FNames As String Dim MyPath As String Dim SaveDriveDir As String Dim Lr As Long SaveDriveDir = CurDir MyPath = "E:\Ron Hoffman\Inpatient\Test\2003 Credit Balances" If Right(MyPath, 1) < "\" Then MyPath = MyPath & "\" End If ChDrive MyPath ChDir MyPath FNames = Dir("*.xls") If Len(FNames) = 0 Then MsgBox "No files in the Directory" ChDrive SaveDriveDir ChDir SaveDriveDir Exit Sub End If On Error GoTo CleanUp Application.ScreenUpdating = False Application.EnableEvents = False Do While FNames < "" Set mybook = Workbooks.Open(FNames, UpdateLinks:=0) facility = Left(mybook, 6) Lr = LastRow(Sheets("Credit Detail")) Sheets("Credit Detail").Range("A1:A" & Lr).Value = facility mybook.Close True FNames = Dir() Loop CleanUp: ChDrive SaveDriveDir ChDir SaveDriveDir Application.ScreenUpdating = True Application.EnableEvents = True End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
split post code (zip code) out of cell that includes full address | Excel Discussion (Misc queries) | |||
Code to conditional format all black after date specified in code? | Excel Discussion (Misc queries) | |||
Drop Down/List w/Code and Definition, only code entered when selec | Excel Worksheet Functions | |||
stubborn Excel crash when editing code with code, one solution | Excel Programming | |||
VBA code delete code but ask for password and unlock VBA protection | Excel Programming |