run-time error 1004

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

KelliInCali - 20 Sep 2007 01:04 GMT

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

Reply to this Message

Bill Renaud - 21 Sep 2007 01:57 GMT

Try a technique like this:
Step through the code to verify that it works the way you want it.

'----------------------------------------------------------------------
'rngData is a column of cells in a list of data,
'not including the header.

Sub DeleteMarkedRows(rngData As Range)
Dim rngCell As Range
Dim rngMarkedCells As Range

'Copy and paste special to eliminate the formulas.
'They should now contain constants (i.e. "Delete", etc.),
'without having to do an Application.Calculate statement.
With rngData
.Copy
.PasteSpecial Paste:=xlPasteValues
End With
Application.CutCopyMode = False

'Now clear the cells that have a non-blank string in them.
For Each rngCell In rngData
With rngCell
If .Value = "" Then .ClearContents
End With
Next rngCell

'Now locate all of the marked cells, and delete only those rows.
Set rngMarkedCells = rngData.SpecialCells(xlCellTypeConstants)
rngMarkedCells.EntireRow.Delete
End Sub

Signature

Regards,
Bill Renaud

Reply to this Message

Bill Renaud - 21 Sep 2007 02:12 GMT

(Untested): You could also use AutoFilter to show only rows that have
"Delete" (or whatever your formula inserted) in them.
Then use:

Set rngMarkedCells = rngData.SpecialCells(xlCellTypeVisible)

You might stilll have to Copy and PasteSpecial to eliminate the formulas
before doing the AutoFilter method, to prevent the cell values from
changing.

Signature

Regards,
Bill Renaud

Reply to this Message

KelliInCali - 21 Sep 2007 22:10 GMT

I don't know why I didn't think of the filtering! I used this and it seems
to work fine, automatically undoing the filter after delete and leaving only
the desired rows:

Cells.Select
Selection.AutoFilter
Selection.AutoFilter Field:=15, Criteria1:="DELETE"
Selection.Delete

Per my reply after your filtering suggestion though, I am still trying to
eliminate the need for "over-estimating" the number of rows to down-fill the
formulas, making it be relative to the used space.

thanks!!
kelli

> (Untested): You could also use AutoFilter to show only rows that have
> "Delete" (or whatever your formula inserted) in them.
[quoted text clipped - 5 lines]
> before doing the AutoFilter method, to prevent the cell values from
> changing.

Reply to this Message

Bill Renaud - 23 Sep 2007 05:14 GMT

I'm glad this appears to be working for you, but I am always a little leery
of using code like:

Cells.Select
Selection.AutoFilter
Selection.AutoFilter Field:=15, Criteria1:="DELETE"
Selection.Delete

as you can't always rely on what the Selection might be after doing several
operations, especially since your first line selects all cells on the
worksheet. This technique might cause all of your data to disappear
someday! Be very careful about this!

Signature

Regards,
Bill Renaud

Reply to this Message

KelliInCali - 21 Sep 2007 21:08 GMT

Thanks for the suggestion Bill... This doesn't seem to work for me, probably
because I don't know how to properly insert your code. But I think I need to
consolidate some of what I'm doing anyway. I think I have figured out a
better way, but now I need to know something else, if you don't mind
continuing with this:

How do I "fill down" a formula in a column based not on an absolute row
range but on the last used row of a different column? I've tried every
syntax I can think of but can't make it work.

Basically, I want to fill down from "O1", with the last row being equivalent
to the last used row in "A".

tia,
kelli

> Try a technique like this:
> Step through the code to verify that it works the way you want it.
[quoted text clipped - 27 lines]
> rngMarkedCells.EntireRow.Delete
> End Sub

Reply to this Message

Bill Renaud - 23 Sep 2007 05:39 GMT

Kelli wrote:
<<How do I "fill down" a formula in a column based not on an absolute row
range but on the last used row of a different column? I've tried every
syntax I can think of but can't make it work.

Basically, I want to fill down from "O1", with the last row being
equivalent
to the last used row in "A".>>

(Normally, you would have column labels (headers) in row 1, so you would
actually enter the formula in O2, then fill down from there.)
But, the simplest thing you can use would be something like the following
(untested):

Dim LastRow As Long

LastRow = ActiveSheet.UsedRange.Rows.Count 'assuming the data
starts in row 1.
Range("O1:O" & LastRow).Formula = "=A1+B1/C1" 'or whatever the
formula is.

Signature

Regards,
Bill Renaud

Reply to this Message

KelliInCali - 24 Sep 2007 20:32 GMT

Hmm... I can't seem to get this to work either. I tried to Set LastRow, and
get Object required error. Do I just do With LastRow = ...?

There are no headers yet (they come later). Am I missing something on the
syntax for the 'LastRow = ActiveSheet.UsedRange.Rows.Count' line?

thanks,
kelli

> Kelli wrote:
> <<How do I "fill down" a formula in a column based not on an absolute row
[quoted text clipped - 16 lines]
> Range("O1:O" & LastRow).Formula = "=A1+B1/C1" 'or whatever the
> formula is.

Reply to this Message

Bill Renaud - 24 Sep 2007 21:20 GMT

Hi Kelli,

No, you are not missing anything on the line where "LastRow =
ActiveSheet.UsedRange.Rows.Count".

Use the code as given. Here is the complete routine, as I tested it.
LastRow is a Long data type (a long form of integer). It is not an object
variable, so it does not need to be "Set". If you step through the code
(use the <F8> key) and watch the Locals window, you will see LastRow take
on the value of how many rows you currently have on your worksheet. The
next line of code will then fill in the formula in column $O from row 1
down to the last row. I removed the comments I had to prevent them from
causing line wrap problems when you cut and paste the code from the
newsgroup into a code window in Excel.

Public Sub FillColumnO()
Dim LastRow As Long

LastRow = ActiveSheet.UsedRange.Rows.Count
Range("O1:O" & LastRow).Formula = "=A1+B1/C1"
End Sub

If you had an object variable, then you would use "Set" as in the following
example. Try this routine also, just to see how an object variable works.

Public Sub GetList()
Dim rngList As Range

Set rngList = ActiveSheet.UsedRange

rngList.Select
End Sub

Signature

Regards,
Bill Renaud

Reply to this Message