End of Page

R

Ralph Hill

I have 2 diffrent Sub-Macro's that I run and neither seems
to work as well as I would like. I am running a macro
multiple times (i.e., 300 times a month). In many cases
the Text document I am Importing and formatting may be
Empty or only have 1-Line of text or 10000 Lines of Text.

I am able to setup my columns and run all of the
formatting I want done if there are 2 or more lines of
text. However, when thre is only 1-line of text or the
document is EMPTY, the Macro gets hung up. below are the
2 different versions I am currently using. Any and all
help would be appreicated. The Second example is based on
whether or not there is an "X" in column "W". The "X" is
added with the following formula in Column-W, =IF
(A1>"","X",""). This is copied to approximatley 10000
rows. This seems to work however, I am then left with
excessive amount of blank rows, resulting in an extremely
large file due to the blank rows.

EXAMPLE 1:

'INSERT ANCHOR CELL FORMULA FOR THIS SECTION TO COPY AND
PASTE FORMULAS TO BOTTOM OF SHEET
Range("B2").Select
ActiveWorkbook.Names.Add Name:="RecorderFormulaB",
RefersToR1C1:= _
"=Recorders65!R2C2"
Range("B2").FormulaR1C1 = "='MACRO 9006 Regen Capacity
Study Ver 65.xls'!ExtractElement(RC[-1],1,""-"")"
'Defines a variable called anchor cell
Application.Goto Reference:="RecorderFormulaB",
Scroll:=False
Selection.Copy
AnchorCell = ActiveCell.Offset(1, 0).Address
ActiveCell.Offset(0, -1).Select
ActiveCell.End(xlDown).Select
EndCell = ActiveCell.Offset(0, 1).Address
Range(AnchorCell, EndCell).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Application.Goto Reference:="RecorderFormulaB",
Scroll:=False
Range("B:B").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False



EXAMPLE 2:

Const SAVESTR As String = "X"
Dim myRange As Range
Dim cell As Range
Dim delRange As Range

Columns("W:W").Select
On Error Resume Next
Selection.Find(What:=SAVESTR, After:=ActiveCell,
LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows,
SearchDirection:=xlNext, MatchCase:= _
False).Activate
If Err.Number <> 91 And Err.Number <> 0 Then
MsgBox "Unresolved Error"
Exit Sub
End If
If ActiveCell.Row > 1 Then
Set myRange = Range("W1").Resize(Range( _
"W" & Rows.Count).End(xlUp).Row, 1)
For Each cell In myRange
If cell.Value <> SAVESTR Then
If delRange Is Nothing Then
Set delRange = cell
Else
Set delRange = Union(delRange, cell)
End If
End If
Next cell
If Not delRange Is Nothing Then
delRange.EntireRow.Delete
Columns("A:A").ColumnWidth = 2
Else
Columns("A:A").ColumnWidth = 20
End If
Application.ScreenUpdating = False
End Sub
 
D

Don Guillett

1.It appears that you are going to a lot of unnecessary trouble. Try this
idea

Sub PutFormula()
Set frng = Range("b3:b" & Range("b65536").End(xlUp).Row)
With frng
.Formula = "=h7+d8"
.Formula = .Value
End With
End Sub


--
Don Guillett
SalesAid Software
(e-mail address removed)
Ralph Hill said:
I have 2 diffrent Sub-Macro's that I run and neither seems
to work as well as I would like. I am running a macro
multiple times (i.e., 300 times a month). In many cases
the Text document I am Importing and formatting may be
Empty or only have 1-Line of text or 10000 Lines of Text.

I am able to setup my columns and run all of the
formatting I want done if there are 2 or more lines of
text. However, when thre is only 1-line of text or the
document is EMPTY, the Macro gets hung up. below are the
2 different versions I am currently using. Any and all
help would be appreicated. The Second example is based on
whether or not there is an "X" in column "W". The "X" is
added with the following formula in Column-W, =IF
(A1>"","X",""). This is copied to approximatley 10000
rows. This seems to work however, I am then left with
excessive amount of blank rows, resulting in an extremely
large file due to the blank rows.

EXAMPLE 1:

'INSERT ANCHOR CELL FORMULA FOR THIS SECTION TO COPY AND
PASTE FORMULAS TO BOTTOM OF SHEET
Range("B2").Select
ActiveWorkbook.Names.Add Name:="RecorderFormulaB",
RefersToR1C1:= _
"=Recorders65!R2C2"
Range("B2").FormulaR1C1 = "='MACRO 9006 Regen Capacity
Study Ver 65.xls'!ExtractElement(RC[-1],1,""-"")"
'Defines a variable called anchor cell
Application.Goto Reference:="RecorderFormulaB",
Scroll:=False
Selection.Copy
AnchorCell = ActiveCell.Offset(1, 0).Address
ActiveCell.Offset(0, -1).Select
ActiveCell.End(xlDown).Select
EndCell = ActiveCell.Offset(0, 1).Address
Range(AnchorCell, EndCell).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Application.Goto Reference:="RecorderFormulaB",
Scroll:=False
Range("B:B").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False



EXAMPLE 2:

Const SAVESTR As String = "X"
Dim myRange As Range
Dim cell As Range
Dim delRange As Range

Columns("W:W").Select
On Error Resume Next
Selection.Find(What:=SAVESTR, After:=ActiveCell,
LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows,
SearchDirection:=xlNext, MatchCase:= _
False).Activate
If Err.Number <> 91 And Err.Number <> 0 Then
MsgBox "Unresolved Error"
Exit Sub
End If
If ActiveCell.Row > 1 Then
Set myRange = Range("W1").Resize(Range( _
"W" & Rows.Count).End(xlUp).Row, 1)
For Each cell In myRange
If cell.Value <> SAVESTR Then
If delRange Is Nothing Then
Set delRange = cell
Else
Set delRange = Union(delRange, cell)
End If
End If
Next cell
If Not delRange Is Nothing Then
delRange.EntireRow.Delete
Columns("A:A").ColumnWidth = 2
Else
Columns("A:A").ColumnWidth = 20
End If
Application.ScreenUpdating = False
End Sub
Click to expand...
 
G

Guest

Don,

How would I go About using this? with a formula for
Column "B" for Example?

"='MACRO 9006 Regen Capacity Study Ver 65.xls'!
ExtractElement(RC[-1],1,""-"")"
-----Original Message-----
1.It appears that you are going to a lot of unnecessary trouble. Try this
idea

Sub PutFormula()
Set frng = Range("b3:b" & Range("b65536").End(xlUp).Row)
With frng
.Formula = "=h7+d8"
.Formula = .Value
End With
End Sub


--
Don Guillett
SalesAid Software
(e-mail address removed)
Ralph Hill said:
I have 2 diffrent Sub-Macro's that I run and neither seems
to work as well as I would like. I am running a macro
multiple times (i.e., 300 times a month). In many cases
the Text document I am Importing and formatting may be
Empty or only have 1-Line of text or 10000 Lines of Text.

I am able to setup my columns and run all of the
formatting I want done if there are 2 or more lines of
text. However, when thre is only 1-line of text or the
document is EMPTY, the Macro gets hung up. below are the
2 different versions I am currently using. Any and all
help would be appreicated. The Second example is based on
whether or not there is an "X" in column "W". The "X" is
added with the following formula in Column-W, =IF
(A1>"","X",""). This is copied to approximatley 10000
rows. This seems to work however, I am then left with
excessive amount of blank rows, resulting in an extremely
large file due to the blank rows.

EXAMPLE 1:

'INSERT ANCHOR CELL FORMULA FOR THIS SECTION TO COPY AND
PASTE FORMULAS TO BOTTOM OF SHEET
Range("B2").Select
ActiveWorkbook.Names.Add Name:="RecorderFormulaB",
RefersToR1C1:= _
"=Recorders65!R2C2"
Range("B2").FormulaR1C1 = "='MACRO 9006 Regen Capacity
Study Ver 65.xls'!ExtractElement(RC[-1],1,""-"")"
'Defines a variable called anchor cell
Application.Goto Reference:="RecorderFormulaB",
Scroll:=False
Selection.Copy
AnchorCell = ActiveCell.Offset(1, 0).Address
ActiveCell.Offset(0, -1).Select
ActiveCell.End(xlDown).Select
EndCell = ActiveCell.Offset(0, 1).Address
Range(AnchorCell, EndCell).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Application.Goto Reference:="RecorderFormulaB",
Scroll:=False
Range("B:B").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False



EXAMPLE 2:

Const SAVESTR As String = "X"
Dim myRange As Range
Dim cell As Range
Dim delRange As Range

Columns("W:W").Select
On Error Resume Next
Selection.Find(What:=SAVESTR, After:=ActiveCell,
LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows,
SearchDirection:=xlNext, MatchCase:= _
False).Activate
If Err.Number <> 91 And Err.Number <> 0 Then
MsgBox "Unresolved Error"
Exit Sub
End If
If ActiveCell.Row > 1 Then
Set myRange = Range("W1").Resize(Range( _
"W" & Rows.Count).End(xlUp).Row, 1)
For Each cell In myRange
If cell.Value <> SAVESTR Then
If delRange Is Nothing Then
Set delRange = cell
Else
Set delRange = Union(delRange, cell)
End If
End If
Next cell
If Not delRange Is Nothing Then
delRange.EntireRow.Delete
Columns("A:A").ColumnWidth = 2
Else
Columns("A:A").ColumnWidth = 20
End If
Application.ScreenUpdating = False
End Sub
Click to expand...


.
Click to expand...
 
R

Ralph

DON,

NEVER MIND. I was having an attack of the Stupids.

I really appreciate your quick response, and excellent
idea.

-----Original Message-----
Don,

How would I go About using this? with a formula for
Column "B" for Example?

"='MACRO 9006 Regen Capacity Study Ver 65.xls'!
ExtractElement(RC[-1],1,""-"")"
-----Original Message-----
1.It appears that you are going to a lot of unnecessary trouble. Try this
idea

Sub PutFormula()
Set frng = Range("b3:b" & Range("b65536").End(xlUp).Row)
With frng
.Formula = "=h7+d8"
.Formula = .Value
End With
End Sub
Click to expand...
based
on
whether or not there is an "X" in column "W". The "X" is
added with the following formula in Column-W, =IF
(A1>"","X",""). This is copied to approximatley 10000
rows. This seems to work however, I am then left with
excessive amount of blank rows, resulting in an extremely
large file due to the blank rows.

EXAMPLE 1:

'INSERT ANCHOR CELL FORMULA FOR THIS SECTION TO COPY AND
PASTE FORMULAS TO BOTTOM OF SHEET
Range("B2").Select
ActiveWorkbook.Names.Add Name:="RecorderFormulaB",
RefersToR1C1:= _
"=Recorders65!R2C2"
Range("B2").FormulaR1C1 = "='MACRO 9006 Regen Capacity
Study Ver 65.xls'!ExtractElement(RC[-1],1,""-"")"
'Defines a variable called anchor cell
Application.Goto Reference:="RecorderFormulaB",
Scroll:=False
Selection.Copy
AnchorCell = ActiveCell.Offset(1, 0).Address
ActiveCell.Offset(0, -1).Select
ActiveCell.End(xlDown).Select
EndCell = ActiveCell.Offset(0, 1).Address
Range(AnchorCell, EndCell).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Application.Goto Reference:="RecorderFormulaB",
Scroll:=False
Range("B:B").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False



EXAMPLE 2:

Const SAVESTR As String = "X"
Dim myRange As Range
Dim cell As Range
Dim delRange As Range

Columns("W:W").Select
On Error Resume Next
Selection.Find(What:=SAVESTR, After:=ActiveCell,
LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows,
SearchDirection:=xlNext, MatchCase:= _
False).Activate
If Err.Number <> 91 And Err.Number <> 0 Then
MsgBox "Unresolved Error"
Exit Sub
End If
If ActiveCell.Row > 1 Then
Set myRange = Range("W1").Resize(Range( _
"W" & Rows.Count).End(xlUp).Row, 1)
For Each cell In myRange
If cell.Value <> SAVESTR Then
If delRange Is Nothing Then
Set delRange = cell
Else
Set delRange = Union(delRange, cell)
End If
End If
Next cell
If Not delRange Is Nothing Then
delRange.EntireRow.Delete
Columns("A:A").ColumnWidth = 2
Else
Columns("A:A").ColumnWidth = 20
End If
Application.ScreenUpdating = False
End Sub
Click to expand...


.
Click to expand...
.
Click to expand...
 
D

Don Guillett

let us know if it worked for you.

--
Don Guillett
SalesAid Software
(e-mail address removed)
Ralph said:
DON,

NEVER MIND. I was having an attack of the Stupids.

I really appreciate your quick response, and excellent
idea.

-----Original Message-----
Don,

How would I go About using this? with a formula for
Column "B" for Example?

"='MACRO 9006 Regen Capacity Study Ver 65.xls'!
ExtractElement(RC[-1],1,""-"")"
-----Original Message-----
1.It appears that you are going to a lot of unnecessary trouble. Try this
idea

Sub PutFormula()
Set frng = Range("b3:b" & Range("b65536").End(xlUp).Row)
With frng
.Formula = "=h7+d8"
.Formula = .Value
End With
End Sub


--
Don Guillett
SalesAid Software
(e-mail address removed)
I have 2 diffrent Sub-Macro's that I run and neither seems
to work as well as I would like. I am running a macro
multiple times (i.e., 300 times a month). In many cases
the Text document I am Importing and formatting may be
Empty or only have 1-Line of text or 10000 Lines of Text.

I am able to setup my columns and run all of the
formatting I want done if there are 2 or more lines of
text. However, when thre is only 1-line of text or the
document is EMPTY, the Macro gets hung up. below are the
2 different versions I am currently using. Any and all
help would be appreicated. The Second example is
Click to expand...
based
on
whether or not there is an "X" in column "W". The "X" is
added with the following formula in Column-W, =IF
(A1>"","X",""). This is copied to approximatley 10000
rows. This seems to work however, I am then left with
excessive amount of blank rows, resulting in an extremely
large file due to the blank rows.

EXAMPLE 1:

'INSERT ANCHOR CELL FORMULA FOR THIS SECTION TO COPY AND
PASTE FORMULAS TO BOTTOM OF SHEET
Range("B2").Select
ActiveWorkbook.Names.Add Name:="RecorderFormulaB",
RefersToR1C1:= _
"=Recorders65!R2C2"
Range("B2").FormulaR1C1 = "='MACRO 9006 Regen Capacity
Study Ver 65.xls'!ExtractElement(RC[-1],1,""-"")"
'Defines a variable called anchor cell
Application.Goto Reference:="RecorderFormulaB",
Scroll:=False
Selection.Copy
AnchorCell = ActiveCell.Offset(1, 0).Address
ActiveCell.Offset(0, -1).Select
ActiveCell.End(xlDown).Select
EndCell = ActiveCell.Offset(0, 1).Address
Range(AnchorCell, EndCell).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Application.Goto Reference:="RecorderFormulaB",
Scroll:=False
Range("B:B").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False



EXAMPLE 2:

Const SAVESTR As String = "X"
Dim myRange As Range
Dim cell As Range
Dim delRange As Range

Columns("W:W").Select
On Error Resume Next
Selection.Find(What:=SAVESTR, After:=ActiveCell,
LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows,
SearchDirection:=xlNext, MatchCase:= _
False).Activate
If Err.Number <> 91 And Err.Number <> 0 Then
MsgBox "Unresolved Error"
Exit Sub
End If
If ActiveCell.Row > 1 Then
Set myRange = Range("W1").Resize(Range( _
"W" & Rows.Count).End(xlUp).Row, 1)
For Each cell In myRange
If cell.Value <> SAVESTR Then
If delRange Is Nothing Then
Set delRange = cell
Else
Set delRange = Union(delRange, cell)
End If
End If
Next cell
If Not delRange Is Nothing Then
delRange.EntireRow.Delete
Columns("A:A").ColumnWidth = 2
Else
Columns("A:A").ColumnWidth = 20
End If
Application.ScreenUpdating = False
End Sub



.
Click to expand...
.
Click to expand...
Click to expand...
 
G

Guest

DON,

Here is what is happening.

Well,

Let me clarify a little. I guess the reason it was
stopping was the "Set frng = Range("i3:i" was set to "i3",
therefor it looked as though it was stopping when in
reality it was just preforming ans designed for the first
3 cells.

I changed the Macro (see below) to do the whole sheet.
However, I am now left with ZERO's in all of the other
rows (about 63000). If I do this manually the Files size
is about 43kb, with the macro it jumps to 2502Kb.


Sub PutFormula()
Set frng = Range("i65536:i" & Range("i65536").End
(xlUp).Row)
With frng
.Formula = "=IF(RC[-8]>"""",SUM(RC[-5]+RC[-2]),"""")"
.Formula = .Value
End With
End Sub

Any ideas or suggestions?


-----Original Message-----
let us know if it worked for you.

--
Don Guillett
SalesAid Software
(e-mail address removed)
Ralph said:
DON,

NEVER MIND. I was having an attack of the Stupids.

I really appreciate your quick response, and excellent
idea.

-----Original Message-----
Don,

How would I go About using this? with a formula for
Column "B" for Example?

"='MACRO 9006 Regen Capacity Study Ver 65.xls'!
ExtractElement(RC[-1],1,""-"")"
-----Original Message-----
1.It appears that you are going to a lot of unnecessary
trouble. Try this
idea

Sub PutFormula()
Set frng = Range("b3:b" & Range("b65536").End (xlUp).Row)
With frng
.Formula = "=h7+d8"
.Formula = .Value
End With
End Sub


--
Don Guillett
SalesAid Software
(e-mail address removed)
I have 2 diffrent Sub-Macro's that I run and neither
seems
to work as well as I would like. I am running a macro
multiple times (i.e., 300 times a month). In many cases
the Text document I am Importing and formatting may be
Empty or only have 1-Line of text or 10000 Lines of
Text.

I am able to setup my columns and run all of the
formatting I want done if there are 2 or more lines of
text. However, when thre is only 1-line of text or the
document is EMPTY, the Macro gets hung up. below are
the
2 different versions I am currently using. Any and all
help would be appreicated. The Second example is based
on
whether or not there is an "X" in column "W". The "X"
is
added with the following formula in Column-W, =IF
(A1>"","X",""). This is copied to approximatley 10000
rows. This seems to work however, I am then left with
excessive amount of blank rows, resulting in an
extremely
large file due to the blank rows.

EXAMPLE 1:

'INSERT ANCHOR CELL FORMULA FOR THIS SECTION TO COPY AND
PASTE FORMULAS TO BOTTOM OF SHEET
Range("B2").Select
ActiveWorkbook.Names.Add Name:="RecorderFormulaB",
RefersToR1C1:= _
"=Recorders65!R2C2"
Range("B2").FormulaR1C1 = "='MACRO 9006 Regen
Capacity
Study Ver 65.xls'!ExtractElement(RC[-1],1,""-"")"
'Defines a variable called anchor cell
Application.Goto Reference:="RecorderFormulaB",
Scroll:=False
Selection.Copy
AnchorCell = ActiveCell.Offset(1, 0).Address
ActiveCell.Offset(0, -1).Select
ActiveCell.End(xlDown).Select
EndCell = ActiveCell.Offset(0, 1).Address
Range(AnchorCell, EndCell).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Application.Goto Reference:="RecorderFormulaB",
Scroll:=False
Range("B:B").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False



EXAMPLE 2:

Const SAVESTR As String = "X"
Dim myRange As Range
Dim cell As Range
Dim delRange As Range

Columns("W:W").Select
On Error Resume Next
Selection.Find(What:=SAVESTR, After:=ActiveCell,
LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows,
SearchDirection:=xlNext, MatchCase:= _
False).Activate
If Err.Number <> 91 And Err.Number <> 0 Then
MsgBox "Unresolved Error"
Exit Sub
End If
If ActiveCell.Row > 1 Then
Set myRange = Range("W1").Resize(Range( _
"W" & Rows.Count).End(xlUp).Row, 1)
For Each cell In myRange
If cell.Value <> SAVESTR Then
If delRange Is Nothing Then
Set delRange = cell
Else
Set delRange = Union(delRange, cell)
End If
End If
Next cell
If Not delRange Is Nothing Then
delRange.EntireRow.Delete
Columns("A:A").ColumnWidth = 2
Else
Columns("A:A").ColumnWidth = 20
End If
Application.ScreenUpdating = False
End Sub



.

.
Click to expand...
Click to expand...


.
Click to expand...
 
R

Ralph Hill

DON,

Well,

Let me clarify a little. I guess the reason it was
stopping was the "Set frng = Range("i3:i" was set to "i3",
therefor it looked as though it was stopping when in
reality it was just preforming ans designed for the first
3 cells.

I changed the Macro (see below) to do the whole sheet.
However, I am now left with ZERO's in all of the other
rows (about 63000). If I do this manually the Files size
is about 43kb, with the macro it jumps to 2502Kb.


Sub PutFormula()
Set frng = Range("i65536:i" & Range("i65536").End
(xlUp).Row)
With frng
.Formula = "=IF(RC[-8]>"""",SUM(RC[-5]+RC[-2]),"""")"
.Formula = .Value
End With
End Sub

Any ideas or suggestions?

-----Original Message-----
let us know if it worked for you.

--
Don Guillett
SalesAid Software
(e-mail address removed)
Ralph said:
DON,

NEVER MIND. I was having an attack of the Stupids.

I really appreciate your quick response, and excellent
idea.

-----Original Message-----
Don,

How would I go About using this? with a formula for
Column "B" for Example?

"='MACRO 9006 Regen Capacity Study Ver 65.xls'!
ExtractElement(RC[-1],1,""-"")"
-----Original Message-----
1.It appears that you are going to a lot of unnecessary
trouble. Try this
idea

Sub PutFormula()
Set frng = Range("b3:b" & Range("b65536").End (xlUp).Row)
With frng
.Formula = "=h7+d8"
.Formula = .Value
End With
End Sub


--
Don Guillett
SalesAid Software
(e-mail address removed)
I have 2 diffrent Sub-Macro's that I run and neither
seems
to work as well as I would like. I am running a macro
multiple times (i.e., 300 times a month). In many cases
the Text document I am Importing and formatting may be
Empty or only have 1-Line of text or 10000 Lines of
Text.

I am able to setup my columns and run all of the
formatting I want done if there are 2 or more lines of
text. However, when thre is only 1-line of text or the
document is EMPTY, the Macro gets hung up. below are
the
2 different versions I am currently using. Any and all
help would be appreicated. The Second example is based
on
whether or not there is an "X" in column "W". The "X"
is
added with the following formula in Column-W, =IF
(A1>"","X",""). This is copied to approximatley 10000
rows. This seems to work however, I am then left with
excessive amount of blank rows, resulting in an
extremely
large file due to the blank rows.

EXAMPLE 1:

'INSERT ANCHOR CELL FORMULA FOR THIS SECTION TO COPY AND
PASTE FORMULAS TO BOTTOM OF SHEET
Range("B2").Select
ActiveWorkbook.Names.Add Name:="RecorderFormulaB",
RefersToR1C1:= _
"=Recorders65!R2C2"
Range("B2").FormulaR1C1 = "='MACRO 9006 Regen
Capacity
Study Ver 65.xls'!ExtractElement(RC[-1],1,""-"")"
'Defines a variable called anchor cell
Application.Goto Reference:="RecorderFormulaB",
Scroll:=False
Selection.Copy
AnchorCell = ActiveCell.Offset(1, 0).Address
ActiveCell.Offset(0, -1).Select
ActiveCell.End(xlDown).Select
EndCell = ActiveCell.Offset(0, 1).Address
Range(AnchorCell, EndCell).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Application.Goto Reference:="RecorderFormulaB",
Scroll:=False
Range("B:B").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False



EXAMPLE 2:

Const SAVESTR As String = "X"
Dim myRange As Range
Dim cell As Range
Dim delRange As Range

Columns("W:W").Select
On Error Resume Next
Selection.Find(What:=SAVESTR, After:=ActiveCell,
LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows,
SearchDirection:=xlNext, MatchCase:= _
False).Activate
If Err.Number <> 91 And Err.Number <> 0 Then
MsgBox "Unresolved Error"
Exit Sub
End If
If ActiveCell.Row > 1 Then
Set myRange = Range("W1").Resize(Range( _
"W" & Rows.Count).End(xlUp).Row, 1)
For Each cell In myRange
If cell.Value <> SAVESTR Then
If delRange Is Nothing Then
Set delRange = cell
Else
Set delRange = Union(delRange, cell)
End If
End If
Next cell
If Not delRange Is Nothing Then
delRange.EntireRow.Delete
Columns("A:A").ColumnWidth = 2
Else
Columns("A:A").ColumnWidth = 20
End If
Application.ScreenUpdating = False
End Sub



.

.
Click to expand...
Click to expand...


.
Click to expand...
 
D

Don Guillett

Pretty obvious
wrong
Set frng = Range("i65536:i" & Range("i65536").End
right
Set frng = Range("i3:i" & Range("i65536").End


--
Don Guillett
SalesAid Software
(e-mail address removed)
Ralph Hill said:
DON,

Well,

Let me clarify a little. I guess the reason it was
stopping was the "Set frng = Range("i3:i" was set to "i3",
therefor it looked as though it was stopping when in
reality it was just preforming ans designed for the first
3 cells.

I changed the Macro (see below) to do the whole sheet.
However, I am now left with ZERO's in all of the other
rows (about 63000). If I do this manually the Files size
is about 43kb, with the macro it jumps to 2502Kb.


Sub PutFormula()
(xlUp).Row)
Click to expand...
With frng
.Formula = "=IF(RC[-8]>"""",SUM(RC[-5]+RC[-2]),"""")"
.Formula = .Value
End With
End Sub

Any ideas or suggestions?

-----Original Message-----
let us know if it worked for you.

--
Don Guillett
SalesAid Software
(e-mail address removed)
Ralph said:
DON,

NEVER MIND. I was having an attack of the Stupids.

I really appreciate your quick response, and excellent
idea.


-----Original Message-----
Don,

How would I go About using this? with a formula for
Column "B" for Example?

"='MACRO 9006 Regen Capacity Study Ver 65.xls'!
ExtractElement(RC[-1],1,""-"")"
-----Original Message-----
1.It appears that you are going to a lot of unnecessary
trouble. Try this
idea

Sub PutFormula()
Set frng = Range("b3:b" & Range("b65536").End (xlUp).Row)
With frng
.Formula = "=h7+d8"
.Formula = .Value
End With
End Sub


--
Don Guillett
SalesAid Software
(e-mail address removed)
I have 2 diffrent Sub-Macro's that I run and neither
seems
to work as well as I would like. I am running a macro
multiple times (i.e., 300 times a month). In many
cases
the Text document I am Importing and formatting may be
Empty or only have 1-Line of text or 10000 Lines of
Text.

I am able to setup my columns and run all of the
formatting I want done if there are 2 or more lines of
text. However, when thre is only 1-line of text or the
document is EMPTY, the Macro gets hung up. below are
the
2 different versions I am currently using. Any and all
help would be appreicated. The Second example is
based
on
whether or not there is an "X" in column "W". The "X"
is
added with the following formula in Column-W, =IF
(A1>"","X",""). This is copied to approximatley 10000
rows. This seems to work however, I am then left with
excessive amount of blank rows, resulting in an
extremely
large file due to the blank rows.

EXAMPLE 1:

'INSERT ANCHOR CELL FORMULA FOR THIS SECTION TO COPY
AND
PASTE FORMULAS TO BOTTOM OF SHEET
Range("B2").Select
ActiveWorkbook.Names.Add Name:="RecorderFormulaB",
RefersToR1C1:= _
"=Recorders65!R2C2"
Range("B2").FormulaR1C1 = "='MACRO 9006 Regen
Capacity
Study Ver 65.xls'!ExtractElement(RC[-1],1,""-"")"
'Defines a variable called anchor cell
Application.Goto Reference:="RecorderFormulaB",
Scroll:=False
Selection.Copy
AnchorCell = ActiveCell.Offset(1, 0).Address
ActiveCell.Offset(0, -1).Select
ActiveCell.End(xlDown).Select
EndCell = ActiveCell.Offset(0, 1).Address
Range(AnchorCell, EndCell).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Application.Goto Reference:="RecorderFormulaB",
Scroll:=False
Range("B:B").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False



EXAMPLE 2:

Const SAVESTR As String = "X"
Dim myRange As Range
Dim cell As Range
Dim delRange As Range

Columns("W:W").Select
On Error Resume Next
Selection.Find(What:=SAVESTR, After:=ActiveCell,
LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows,
SearchDirection:=xlNext, MatchCase:= _
False).Activate
If Err.Number <> 91 And Err.Number <> 0 Then
MsgBox "Unresolved Error"
Exit Sub
End If
If ActiveCell.Row > 1 Then
Set myRange = Range("W1").Resize(Range( _
"W" & Rows.Count).End(xlUp).Row, 1)
For Each cell In myRange
If cell.Value <> SAVESTR Then
If delRange Is Nothing Then
Set delRange = cell
Else
Set delRange = Union(delRange,
cell)
End If
End If
Next cell
If Not delRange Is Nothing Then
delRange.EntireRow.Delete
Columns("A:A").ColumnWidth = 2
Else
Columns("A:A").ColumnWidth = 20
End If
Application.ScreenUpdating = False
End Sub



.

.
Click to expand...


.
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

RE-End of Page 2
Changing the CONST Variable 1
My Macro does NOT Delete ROWS?? 1
Running Macro on Multiple Worksheets 6
Deleting Sheet with No Data 7
My Macro Won't Delete Rows?? 3
Deleting blank (Cells/Rows) in Excel-VBA 1
Importing Files into Excel using VBA 1

Top