variable number of rows.

K

krigger228

I have created this macro but it cuts off if I have too many rows. Is there a
way to make it run until it hits a blank cell in another column? Here is the
code I have now.

feel free to e-mail me if you need more information.

Sub Macro7()
'
' Macro7 Macro
'

'
Columns("I:I").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("H:H").EntireColumn.AutoFit
Range("I2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-8]=RC[-1],""Goto_View"",""Goto_View_External"")"
Range("I2").Select
Selection.Copy
Range("H2").Select
Selection.End(xlDown).Select
Range("I60487").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Range("A60486").Select
Selection.End(xlUp).Select
Range("I1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "ACTION"
Range("I1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
ActiveWindow.ScrollRow = 60216
ActiveWindow.ScrollRow = 59474
ActiveWindow.ScrollRow = 57743
ActiveWindow.ScrollRow = 55270
ActiveWindow.ScrollRow = 51561
ActiveWindow.ScrollRow = 47109
ActiveWindow.ScrollRow = 42658
ActiveWindow.ScrollRow = 38578
ActiveWindow.ScrollRow = 34869
ActiveWindow.ScrollRow = 31407
ActiveWindow.ScrollRow = 28068
ActiveWindow.ScrollRow = 25101
ActiveWindow.ScrollRow = 23122
ActiveWindow.ScrollRow = 20402
ActiveWindow.ScrollRow = 18919
ActiveWindow.ScrollRow = 17558
ActiveWindow.ScrollRow = 16198
ActiveWindow.ScrollRow = 14838
ActiveWindow.ScrollRow = 13602
ActiveWindow.ScrollRow = 12365
ActiveWindow.ScrollRow = 11376
ActiveWindow.ScrollRow = 10263
ActiveWindow.ScrollRow = 9522
ActiveWindow.ScrollRow = 8409
ActiveWindow.ScrollRow = 7667
ActiveWindow.ScrollRow = 6801
ActiveWindow.ScrollRow = 5936
ActiveWindow.ScrollRow = 4699
ActiveWindow.ScrollRow = 3216
ActiveWindow.ScrollRow = 1732
ActiveWindow.ScrollRow = 372
ActiveWindow.ScrollRow = 1
Range("E1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Columns("I:I").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("I2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-4]=""Goto_View"","""",RC[-1])"
Range("I2").Select
Selection.Copy
Range("H2").Select
Selection.End(xlDown).Select
Range("I60487").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Selection.End(xlUp).Select
Range("I1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "DEST. FILE"
Range("I1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.End(xlUp).Select
Range("H1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=9
Range("H1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Columns("I:I").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
ActiveWindow.LargeScroll ToRight:=1
Columns("W:W").Select
Selection.Cut
ActiveWindow.LargeScroll ToRight:=-1
Columns("A:A").Select
ActiveSheet.Paste
ActiveWindow.LargeScroll ToRight:=1
Range("T2").Select
Selection.Copy
Columns("T:T").Select
Selection.Replace What:="ACROBAT_DEFAULT", Replacement:="NEW_WINDOW", _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False,
SearchFormat:= _
False, ReplaceFormat:=False
Range("T3").Select
Application.CutCopyMode = False
Range("T1").Select
ActiveWindow.LargeScroll ToRight:=-1
Range("A1").Select
Selection.End(xlDown).Select
Range("A1").Select
Selection.End(xlDown).Select
Rows("60488:60488").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("A:A").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.ClearContents
Range("A1").Select
End Sub
 
J

Joel

It is hard to fix code like this. Her is a much improved macro. I made of
made a fgew mistakes but you should easily be able to fix the problems.


Sub Macro7()
'
' Macro7 Macro
'

'
Columns("I:I").Insert Shift:=xlToRight,
CopyOrigin:=xlFormatFromLeftOrAbove
Columns("H:H").EntireColumn.AutoFit
Range("I2").FormulaR1C1 = _
"=IF(RC[-8]=RC[-1],""Goto_View"",""Goto_View_External"")"
LastRow = Range("I" & rows.count).end(xlup).Row

Range("I2").Copy Destination:=Range("H2:H" & Lastrow)

Range("I1").Copy
Range("E1:E" & LastRow).PasteSpecial _
Paste:=xlPasteValues

Columns("I:I").Delete
Application.CutCopyMode = False
Columns("I:I").Insert Shift:=xlToRight,
CopyOrigin:=xlFormatFromLeftOrAbove

Range("I2").FormulaR1C1 = "=IF(RC[-4]=""Goto_View"","""",RC[-1])"
Range("I2").Copy Destination:=Range("H2:H" & LastRow)

Range("I1:I" & LastRow).FormulaR1C1 = "DEST. FILE"

Range("H1").copy destination:=Range("H1:H" & LastRow)

Columns("I:I").Delete

Columns("W:W").Cut
Columns("A:A").Paste

Columns("T:T").Replace _
What:="ACROBAT_DEFAULT", _
Replacement:="NEW_WINDOW", _
LookAt:=xlPart

Rows(Lastrow).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

set FirstBlankCell = Columns("A:A").SpecialCells(xlCellTypeBlanks)
set LastCell = ActiveCell.SpecialCells(xlLastCell)
Range(FirstBlankCell, LastCell).ClearContents
End Sub


krigger228 said:
I have created this macro but it cuts off if I have too many rows. Is there a
way to make it run until it hits a blank cell in another column? Here is the
code I have now.

feel free to e-mail me if you need more information.

Sub Macro7()
'
' Macro7 Macro
'

'
Columns("I:I").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("H:H").EntireColumn.AutoFit
Range("I2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-8]=RC[-1],""Goto_View"",""Goto_View_External"")"
Range("I2").Select
Selection.Copy
Range("H2").Select
Selection.End(xlDown).Select
Range("I60487").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Range("A60486").Select
Selection.End(xlUp).Select
Range("I1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "ACTION"
Range("I1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
ActiveWindow.ScrollRow = 60216
ActiveWindow.ScrollRow = 59474
ActiveWindow.ScrollRow = 57743
ActiveWindow.ScrollRow = 55270
ActiveWindow.ScrollRow = 51561
ActiveWindow.ScrollRow = 47109
ActiveWindow.ScrollRow = 42658
ActiveWindow.ScrollRow = 38578
ActiveWindow.ScrollRow = 34869
ActiveWindow.ScrollRow = 31407
ActiveWindow.ScrollRow = 28068
ActiveWindow.ScrollRow = 25101
ActiveWindow.ScrollRow = 23122
ActiveWindow.ScrollRow = 20402
ActiveWindow.ScrollRow = 18919
ActiveWindow.ScrollRow = 17558
ActiveWindow.ScrollRow = 16198
ActiveWindow.ScrollRow = 14838
ActiveWindow.ScrollRow = 13602
ActiveWindow.ScrollRow = 12365
ActiveWindow.ScrollRow = 11376
ActiveWindow.ScrollRow = 10263
ActiveWindow.ScrollRow = 9522
ActiveWindow.ScrollRow = 8409
ActiveWindow.ScrollRow = 7667
ActiveWindow.ScrollRow = 6801
ActiveWindow.ScrollRow = 5936
ActiveWindow.ScrollRow = 4699
ActiveWindow.ScrollRow = 3216
ActiveWindow.ScrollRow = 1732
ActiveWindow.ScrollRow = 372
ActiveWindow.ScrollRow = 1
Range("E1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Columns("I:I").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("I2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-4]=""Goto_View"","""",RC[-1])"
Range("I2").Select
Selection.Copy
Range("H2").Select
Selection.End(xlDown).Select
Range("I60487").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Selection.End(xlUp).Select
Range("I1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "DEST. FILE"
Range("I1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.End(xlUp).Select
Range("H1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=9
Range("H1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Columns("I:I").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
ActiveWindow.LargeScroll ToRight:=1
Columns("W:W").Select
Selection.Cut
ActiveWindow.LargeScroll ToRight:=-1
Columns("A:A").Select
ActiveSheet.Paste
ActiveWindow.LargeScroll ToRight:=1
Range("T2").Select
Selection.Copy
Columns("T:T").Select
Selection.Replace What:="ACROBAT_DEFAULT", Replacement:="NEW_WINDOW", _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False,
SearchFormat:= _
False, ReplaceFormat:=False
Range("T3").Select
Application.CutCopyMode = False
Range("T1").Select
ActiveWindow.LargeScroll ToRight:=-1
Range("A1").Select
Selection.End(xlDown).Select
Range("A1").Select
Selection.End(xlDown).Select
Rows("60488:60488").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("A:A").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.ClearContents
Range("A1").Select
End Sub
Click to expand...
 
J

Joel

I wouldn't recoomend using the Select method. It is slow and is hard to
read. Look at my code, it is the recoomended way of coding. the macro
recorder code is very cumbersome. I always mdoify any code that I use that
comes from the macro recorder.

Simon Lloyd said:
You would be better off explaining what you are trying to do, there is
so much un needed code there and far too many selects, i have shortened
the code but i don't know what you are trying to achieve as you also
perform needless actions, we could do with seeing you workbook with an
explanation of what you want to do, here's the shortened code, it can be
made smaller:
Code:
--------------------
Sub Macro7()
'
' Macro7 Macro
'
'
Columns("I:I").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("H:H").EntireColumn.AutoFit
Range("I2").ActiveCell.FormulaR1C1 = _
"=IF(RC[-8]=RC[-1],""Goto_View"",""Goto_View_External"")"
Range("I2").Copy
Range("I60487").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Range("I1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "ACTION"
Range("I1").Select
Range(Selection, Selection.End(xlDown)).Copy
Range("E1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("I:I").Delete Shift:=xlToLeft
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("I2").FormulaR1C1 = "=IF(RC[-4]=""Goto_View"","""",RC[-1])"
Selection.Copy
Range("H2").Select
Selection.End(xlDown).Select
Range("I60487").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Selection.End(xlUp).Select
Range("I1").FormulaR1C1 = "DEST. FILE"
Range("I1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.End(xlUp).Select
Range("H1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("I:I").Delete Shift:=xlToLeft
Columns("W:W").Cut
Columns("A:A").Paste
Range("T2").Copy
Columns("T:T").Select
Selection.Replace What:="ACROBAT_DEFAULT", Replacement:="NEW_WINDOW", _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
False, ReplaceFormat:=False
Rows("60488:60488").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("A:A").SpecialCells(xlCellTypeBlanks).Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.ClearContents
Range("A1").Select
Application.CutCopyMode = False
End Sub
--------------------
krigger228;248740 said:
I have created this macro but it cuts off if I have too many rows. Is
there a
way to make it run until it hits a blank cell in another column? Here
is the
code I have now.

feel free to e-mail me if you need more information.
Code:
--------------------Sub Macro7()
'
' Macro7 Macro
'

'
Columns("I:I").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("H:H").EntireColumn.AutoFit
Range("I2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-8]=RC[-1],""Goto_View"",""Goto_View_External"")"
Range("I2").Select
Selection.Copy
Range("H2").Select
Selection.End(xlDown).Select
Range("I60487").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Range("A60486").Select
Selection.End(xlUp).Select
Range("I1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "ACTION"
Range("I1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
ActiveWindow.ScrollRow = 60216
ActiveWindow.ScrollRow = 59474
ActiveWindow.ScrollRow = 57743
ActiveWindow.ScrollRow = 55270
ActiveWindow.ScrollRow = 51561
ActiveWindow.ScrollRow = 47109
ActiveWindow.ScrollRow = 42658
ActiveWindow.ScrollRow = 38578
ActiveWindow.ScrollRow = 34869
ActiveWindow.ScrollRow = 31407
ActiveWindow.ScrollRow = 28068
ActiveWindow.ScrollRow = 25101
ActiveWindow.ScrollRow = 23122
ActiveWindow.ScrollRow = 20402
ActiveWindow.ScrollRow = 18919
ActiveWindow.ScrollRow = 17558
ActiveWindow.ScrollRow = 16198
ActiveWindow.ScrollRow = 14838
ActiveWindow.ScrollRow = 13602
ActiveWindow.ScrollRow = 12365
ActiveWindow.ScrollRow = 11376
ActiveWindow.ScrollRow = 10263
ActiveWindow.ScrollRow = 9522
ActiveWindow.ScrollRow = 8409
ActiveWindow.ScrollRow = 7667
ActiveWindow.ScrollRow = 6801
ActiveWindow.ScrollRow = 5936
ActiveWindow.ScrollRow = 4699
ActiveWindow.ScrollRow = 3216
ActiveWindow.ScrollRow = 1732
ActiveWindow.ScrollRow = 372
ActiveWindow.ScrollRow = 1
Range("E1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Columns("I:I").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("I2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-4]=""Goto_View"","""",RC[-1])"
Range("I2").Select
Selection.Copy
Range("H2").Select
Selection.End(xlDown).Select
Range("I60487").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Selection.End(xlUp).Select
Range("I1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "DEST. FILE"
Range("I1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.End(xlUp).Select
Range("H1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=9
Range("H1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Columns("I:I").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
ActiveWindow.LargeScroll ToRight:=1
Columns("W:W").Select
Selection.Cut
ActiveWindow.LargeScroll ToRight:=-1
Columns("A:A").Select
ActiveSheet.Paste
ActiveWindow.LargeScroll ToRight:=1
Range("T2").Select
Selection.Copy
Columns("T:T").Select
Selection.Replace What:="ACROBAT_DEFAULT", Replacement:="NEW_WINDOW", _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False,
SearchFormat:= _
False, ReplaceFormat:=False
Range("T3").Select
Application.CutCopyMode = False
Range("T1").Select
ActiveWindow.LargeScroll ToRight:=-1
Range("A1").Select
Selection.End(xlDown).Select
Range("A1").Select
Selection.End(xlDown).Select
Rows("60488:60488").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("A:A").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.ClearContents
Range("A1").Select
End Sub
--------------------
Click to expand...


--
Simon Lloyd

Regards,
Simon Lloyd
'The Code Cage' (http://www.thecodecage.com)
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

fixing a run-time error'9': Subscript out of range 0
Need Help with VBA code for an Excel Model Macro 5
Retaining data on clipboard after close without prompt. 1
Where am I going wrong? 2
Macro that deletes and pastes filterd rows and then some 2
File Name changes with dates and Deleting Rows of Zeros 0
macro to copy rows that contain a cell with a certain number 2
Macro to hide rows with a certain cell empty then set print area and print 12

Top