Hello... I have some clunky VB code that runs fine if I "run to cursor" in
stages, but if I try to run it complete by itself I get the following
run-time error:

Method 'Union' of object '_Global' failed.

After importing delimited data and splitting it to columns, I'm using VB to
create worksheet formulas to identify rows I want deleted, and then using VB
to delete the rows.

Since the formulas get screwed up after the first round of deletes, I am
putting them in one at a time and running the delete scenario after each.

The second "create-formula/row.delete" scenario is the one that is causing
the error, though it runs fine running in stages:
--- Set newdelRng = Union(rCell, newdelRng) ---

I know this is not pretty code, and what I am trying to do could probably be
accomplished much easier by a smarter author, but this is what I've got...
any help?



Sub Sats2MBS()

Application.Calculation = xlAutomatic

' Deletes top 3 extraneous rows, splits remaining delimited text to columns
Rows("1:3").Select
Range("A3").Activate
Selection.Delete Shift:=xlUp
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"),
DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(5, 2), Array(9, 2), Array(30,
2), Array(46, 2), _
Array(62, 1), Array(73, 1), Array(84, 2), Array(88, 1), Array(90,
1)), _
TrailingMinusNumbers:=True


' Installs "Blank Rows" formula in "R"
Range("R1").Select
ActiveCell.FormulaR1C1 = _

"=IF(COUNTA(R1C1:R50C1)<1,"""",IF(COUNTA(RC[-17]:RC[-5])<1,""DELETE"",""""))"
Range("R1:R50000").Select
Selection.FillDown

' Copies and Pastes values for entire sheet to eliminate formulas
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

' Sorts by column R so row removal sequence runs faster
Cells.Select
Selection.Sort Key1:=Range("r2"), Order1:=xlDescending, Header:=xlGuess,
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
xlSortNormal


' Deletes empty rows based on formula in "R"
Dim rng As Range
Dim rCell As Range
Dim delRng As Range
Dim WB As Workbook
Dim SH As Worksheet
Dim CalcMode As Long

Set WB = ActiveWorkbook

Set SH = WB.Sheets("X")
Set rng = Intersect(SH.UsedRange, SH.Columns("R:R"))

On Error GoTo XIT
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

For Each rCell In rng.Cells
If rCell.Value = "DELETE" Then
If delRng Is Nothing Then
Set delRng = rCell
Else
Set delRng = Union(rCell, delRng)
End If
End If
Next rCell

If Not delRng Is Nothing Then
delRng.EntireRow.Delete
End If

XIT:
With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With


Application.Calculation = xlAutomatic

' Installs "Store Comparison" formulas in "R"
Range("r1").Select
ActiveCell.FormulaR1C1 = _

"=IF(COUNTA(R1C1:R50C1)<1,"""",IF(AND(R[-1]C[-5]=1,RC[-5]<1,ISBLANK(R[-1]C[-4])),"""",""DELETE""))"
Range("r2").Select
ActiveCell.FormulaR1C1 = _

"=IF(COUNTA(R1C1:R50C1)<1,"""",IF(AND(R[-1]C[-5]=1,RC[-5]<1,ISBLANK(R[-1]C[-4])),"""",""DELETE""))"
Range("r2:r50000").Select
Selection.FillDown

' Copies and Pastes values for entire sheet to eliminate formulas
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

' Sorts by column R so row removal sequence runs faster
Cells.Select
Selection.Sort Key1:=Range("r2"), Order1:=xlDescending, Header:=xlGuess,
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
xlSortNormal


' Deletes rows based on formula in "R"
Dim newdelRng As Range

Set WB = ActiveWorkbook

Set SH = WB.Sheets("X")
Set rng = Intersect(SH.UsedRange, SH.Columns("R:R"))

On Error GoTo XIT
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

For Each rCell In rng.Cells
If rCell.Value = "DELETE" Then
If newdelRng Is Nothing Then
Set newdelRng = rCell
Else
Set newdelRng = Union(rCell, newdelRng)
End If
End If
Next rCell

If Not newdelRng Is Nothing Then
newdelRng.EntireRow.Delete
End If


Application.Calculation = xlAutomatic

' Installs "Blank $" formula in "R"
Range("r1").Select
ActiveCell.FormulaR1C1 = _
"=IF(isblank(rc[-8]),""DELETE"","""")"
Range("r1:r50000").Select
Selection.FillDown

' Copies and Pastes values for entire sheet to eliminate formulas
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

' Sorts by column R so row removal sequence runs faster
Cells.Select
Selection.Sort Key1:=Range("r2"), Order1:=xlDescending, Header:=xlGuess,
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
xlSortNormal


' Deletes rows based on formula in "R"
Dim lastdelRng As Range

Set WB = ActiveWorkbook

Set SH = WB.Sheets("X")
Set rng = Intersect(SH.UsedRange, SH.Columns("R:R"))

On Error GoTo XIT
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

For Each rCell In rng.Cells
If rCell.Value = "DELETE" Then
If lastdelRng Is Nothing Then
Set lastdelRng = rCell
Else
Set lastdelRng = Union(rCell, lastdelRng)
End If
End If
Next rCell

If Not lastdelRng Is Nothing Then
lastdelRng.EntireRow.Delete
End If

' Copies all, calls template with formulas, pastes values into template
Dim FirstCell As Range
Dim LastCell As Range

If Not IsEmpty(Range("B1")) Then
Set FirstCell = Range("A1")
Else
Set FirstCell = Range("A1").End(xlDown)
End If
Set LastCell = Cells(Rows.Count, "B").End(xlUp)
Range(FirstCell, LastCell).EntireRow.Copy


Workbooks.Add Template:="C:\Documents and Settings\kellyh\Desktop\UPC
Reports\Format.UPC.sats.xlt"

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=True, Transpose:=False


End Sub