Thread: Macro Run Error
View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Ken[_18_] Ken[_18_] is offline
external usenet poster
 
Posts: 45
Default Macro Run Error

With the help of folks on this site we have developed the
following macro.

Option Explicit
--------------------------------------------------
Sub ImportFile()

ChDir "C:\Downloads"
Workbooks.OpenText Filename:="C:\Downloads\889B.txt",
Origin:=xlWindows, _
StartRow:=15, DataType:=xlFixedWidth,
FieldInfo:=Array(Array(0, 1), Array( _
15, 1), Array(26, 1), Array(42, 1), Array(57, 1),
Array(72, 1), Array(87, 1), Array(102, 1), _
Array(117, 1))

DeleteBlankRows

ActiveWorkbook.SaveAs Filename:="L:\FRMS\BUDGET\PATs.xls",
FileFormat:= _
xlNormal, Password:="", WriteResPassword:="",
ReadOnlyRecommended:=False _
, CreateBackup:=False
ActiveWorkbook.Close
Workbooks.Open Filename:="L:\FRMS\BUDGET\PATs.xls"

Sort_PATs

End Sub
-------------------------------
Sub DeleteBlankRows()

Dim R As Long
Dim C As Range
Dim N As Long
Dim rng As Range
Dim LastRow As Long

On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

LastRow = Range("A65536").End(xlUp).Row
Range("A" & LastRow & ":A" & LastRow - 21).EntireRow.Delete

If Selection.Rows.Count 1 Then
Set rng = Selection
Else
Set rng = ActiveSheet.UsedRange.Rows
End If
N = 0
For R = rng.Rows.Count To 1 Step -1
If Application.WorksheetFunction.CountA(rng.Rows
(R).EntireRow) = 0 Then
rng.Rows(R).EntireRow.Delete
For N = 1 To 9
rng.Rows(R).EntireRow.Delete
Next N
End If
Next R

EndMacro:

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub
------------------------------------
Sub Sort_PATs()
Dim i As Long, lngLastRow As Long, rng As Range

With Sheet1
lngLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lngLastRow
If IsEmpty(.Cells(i, 3).Value) Then
If Not rng Is Nothing Then CopyRangeToWKS
rng
Set rng = .Rows(i)
Else
Set rng = Union(rng, .Rows(i))
End If
Next

If Not rng Is Nothing Then CopyRangeToWKS rng
End With
End Sub
-----------------------------------------------
Sub CopyRangeToWKS(rng As Range)
Dim wks As Worksheet

Set wks = Worksheets.Add(After:=Worksheets
(Worksheets.Count))

wks.Name = rng.Cells(1).Value
wks.Cells(1, 3).Value = "PAT"
wks.Cells(1, 4).Value = "0-30"
wks.Cells(1, 5).Value = "31-60"
wks.Cells(1, 6).Value = "61-90"
wks.Cells(1, 7).Value = "91-120"
wks.Cells(1, 8).Value = "121-180"
wks.Cells(1, 9).Value = "180"
rng.Copy wks.Cells(2, 1)
Rows("2:2").Delete
Columns("A:B").Delete
Range("1:1").Select
With Selection
.HorizontalAlignment = xlCenter
End With
Columns("A:I").EntireColumn.AutoFit
End Sub

This macro is stored in an Excel workbook. When we run it,
it imports a text file; deletes some unwanted rows; and
then copies ranges of data from the imported worksheet to
new worksheets.

When we run this macro, however, we get:
"Run-time error '1004':"
"Method 'Name' of object'_Worksheet' failed"

When we debug, it highlights:
"wks.Name = rng.Cells(1).Value"
in the macro.

If we run the first two sub-routines in the macro, copy
the last two sub-routines to the new workbook, close the
master workbook containing the macros, , and run the last
two subs in the new workbook, they work okay.

If we haven't confused you, can anyone tell us what we
need to change?

Thanks for your help!