|
End of Page
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 |
End of Page
|
End of Page
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 "Ralph Hill" wrote in message ... 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 . |
End of Page
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 "Ralph Hill" wrote in message ... 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 . . |
End of Page
|
End of Page
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 "Ralph" wrote in message ... 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 "Ralph Hill" wrote in message ... 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 . . . |
End of Page
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 "Ralph" wrote in message ... 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 "Ralph Hill" wrote in message ... 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 . . . |
End of Page
|
| All times are GMT +1. The time now is 09:10 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com