Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Problem with Macros in VB (2 Parts)
This is 2 parts and please let me know if you need anymore information.
*1)* I would like to know what the code to write the funtion =ISNUMBER(MATCH(RC[-3],ITPatches!C[-4],0)) in all cels going down one column for only the rows that are not empt or until the cell in coumn a that says End. What I have right now is this: Range("E2").Select ActiveCell.FormulaR1C1 "=ISNUMBER(MATCH(RC[-3],ITPatches!C[-4],0))" Range("F2").Select ActiveCell.FormulaR1C1 "=ISNUMBER(MATCH(RC[-4],ITPatches!C[-4],0))" Range("G2").Select ActiveCell.FormulaR1C1 "=ISNUMBER(MATCH(RC[-5],ITPatches!C[-4],0))" Range("E2:G2").Select Selection.AutoFill Destination:=Range("E2:G5000") Type:=xlFillCopy Range("E2:G5000").Select ActiveWindow.ScrollRow = 4995 ActiveWindow.ScrollRow = 4989 ActiveWindow.ScrollRow = 4983 ActiveWindow.ScrollRow = 4977 ActiveWindow.ScrollRow = 4965 ActiveWindow.ScrollRow = 4941 ActiveWindow.ScrollRow = 4916 ActiveWindow.ScrollRow = 4886 ActiveWindow.ScrollRow = 4862 ActiveWindow.ScrollRow = 4814 ActiveWindow.ScrollRow = 4765 ActiveWindow.ScrollRow = 4711 ActiveWindow.ScrollRow = 4663 ActiveWindow.ScrollRow = 4614 ActiveWindow.ScrollRow = 4560 ActiveWindow.ScrollRow = 4445 ActiveWindow.ScrollRow = 4391 ActiveWindow.ScrollRow = 4324 ActiveWindow.ScrollRow = 4264 ActiveWindow.ScrollRow = 4197 ActiveWindow.ScrollRow = 4070 ActiveWindow.ScrollRow = 4004 ActiveWindow.ScrollRow = 3949 ActiveWindow.ScrollRow = 3834 ActiveWindow.ScrollRow = 3780 ActiveWindow.ScrollRow = 3738 ActiveWindow.ScrollRow = 3695 ActiveWindow.ScrollRow = 3647 ActiveWindow.ScrollRow = 3550 ActiveWindow.ScrollRow = 3508 ActiveWindow.ScrollRow = 3441 ActiveWindow.ScrollRow = 3393 ActiveWindow.ScrollRow = 3339 ActiveWindow.ScrollRow = 3218 ActiveWindow.ScrollRow = 3145 ActiveWindow.ScrollRow = 3073 ActiveWindow.ScrollRow = 2922 ActiveWindow.ScrollRow = 2843 ActiveWindow.ScrollRow = 2758 ActiveWindow.ScrollRow = 2680 ActiveWindow.ScrollRow = 2601 ActiveWindow.ScrollRow = 2529 ActiveWindow.ScrollRow = 2366 ActiveWindow.ScrollRow = 2293 ActiveWindow.ScrollRow = 2214 ActiveWindow.ScrollRow = 2069 ActiveWindow.ScrollRow = 1997 ActiveWindow.ScrollRow = 1942 ActiveWindow.ScrollRow = 1821 ActiveWindow.ScrollRow = 1755 ActiveWindow.ScrollRow = 1695 ActiveWindow.ScrollRow = 1634 ActiveWindow.ScrollRow = 1580 ActiveWindow.ScrollRow = 1525 ActiveWindow.ScrollRow = 1477 ActiveWindow.ScrollRow = 1368 ActiveWindow.ScrollRow = 1320 ActiveWindow.ScrollRow = 1271 ActiveWindow.ScrollRow = 1235 ActiveWindow.ScrollRow = 1187 ActiveWindow.ScrollRow = 1144 ActiveWindow.ScrollRow = 1102 ActiveWindow.ScrollRow = 1072 ActiveWindow.ScrollRow = 1036 ActiveWindow.ScrollRow = 999 ActiveWindow.ScrollRow = 963 ActiveWindow.ScrollRow = 921 ActiveWindow.ScrollRow = 891 ActiveWindow.ScrollRow = 854 ActiveWindow.ScrollRow = 818 ActiveWindow.ScrollRow = 788 ActiveWindow.ScrollRow = 758 ActiveWindow.ScrollRow = 721 ActiveWindow.ScrollRow = 697 ActiveWindow.ScrollRow = 673 ActiveWindow.ScrollRow = 649 ActiveWindow.ScrollRow = 619 ActiveWindow.ScrollRow = 594 ActiveWindow.ScrollRow = 570 ActiveWindow.ScrollRow = 552 ActiveWindow.ScrollRow = 528 ActiveWindow.ScrollRow = 510 ActiveWindow.ScrollRow = 486 ActiveWindow.ScrollRow = 461 ActiveWindow.ScrollRow = 443 ActiveWindow.ScrollRow = 419 ActiveWindow.ScrollRow = 401 ActiveWindow.ScrollRow = 383 ActiveWindow.ScrollRow = 371 ActiveWindow.ScrollRow = 353 ActiveWindow.ScrollRow = 334 ActiveWindow.ScrollRow = 322 ActiveWindow.ScrollRow = 310 ActiveWindow.ScrollRow = 298 ActiveWindow.ScrollRow = 280 ActiveWindow.ScrollRow = 268 ActiveWindow.ScrollRow = 262 ActiveWindow.ScrollRow = 250 ActiveWindow.ScrollRow = 244 ActiveWindow.ScrollRow = 226 ActiveWindow.ScrollRow = 214 ActiveWindow.ScrollRow = 208 ActiveWindow.ScrollRow = 195 ActiveWindow.ScrollRow = 183 ActiveWindow.ScrollRow = 171 ActiveWindow.ScrollRow = 165 ActiveWindow.ScrollRow = 159 ActiveWindow.ScrollRow = 153 ActiveWindow.ScrollRow = 135 ActiveWindow.ScrollRow = 129 ActiveWindow.ScrollRow = 123 ActiveWindow.ScrollRow = 117 ActiveWindow.ScrollRow = 105 ActiveWindow.ScrollRow = 99 ActiveWindow.ScrollRow = 93 ActiveWindow.ScrollRow = 87 ActiveWindow.ScrollRow = 81 ActiveWindow.ScrollRow = 75 ActiveWindow.ScrollRow = 68 ActiveWindow.ScrollRow = 62 ActiveWindow.ScrollRow = 56 ActiveWindow.ScrollRow = 50 ActiveWindow.ScrollRow = 44 ActiveWindow.ScrollRow = 38 ActiveWindow.ScrollRow = 32 ActiveWindow.ScrollRow = 26 ActiveWindow.ScrollRow = 20 ActiveWindow.ScrollRow = 14 ActiveWindow.ScrollRow = 8 ActiveWindow.ScrollRow = 2 Range("A1").Select What I want is to jnot have to do it 5000 rows, but do it only for the rows that are not a blank cell in coumn A. Or ic can be written until the cell in column a that sats End. For I add an the word End at the end of the txt file excel is opening. *2)* I found this next code from a link in this forum but i would like to change it around a bit: Sub Delete_Row() Dim Firstrow As Long Dim Lastrow As Long Dim Lrow As Long Dim CalcMode As Long With Application CalcMode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False End With Firstrow = ActiveSheet.UsedRange.Cells(1).Row Lastrow = ActiveSheet.UsedRange.Rows.Count + Firstrow - 1 With ActiveSheet .DisplayPageBreaks = False For Lrow = Lastrow To Firstrow Step -1 If IsError(.Cells(Lrow, "A").Value) Then 'Do nothing, This avoid a error if there is a error in the cell ElseIf .Cells(Lrow, "A").Value = "" Then .Rows(Lrow).Delete 'This will delete each row with the Value "" in Column A, case sensitive. End If Next End With With Application .ScreenUpdating = True .Calculation = CalcMode End With End Sub I have changed this to delete any rows that are blank, But I think it is taking so long to run because it is deleteing all the rows after my data also, all the way down to 65,000 whatever. The last row in my daya, once again, has the word end in Column A. Is there a way to tell this to stop dleteing emtpy rows once it hits the word End? (I thank you all for your help and promise that I am slowly learning this when I find time here at work, going over 5 books of VB and such. And soon will have my work pay for me to go get a certification in this. But I thank you for helping me while i am still in my puppy state) --- Message posted from http://www.ExcelForum.com/ |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Problem with Macros in VB (2 Parts)
Sub Tester1()
Dim rng As Range, rng1 As Range Dim rng2 As Range Set rng = Cells(Rows.Count, 1).End(xlUp) Set rng1 = rng If LCase(Trim(rng1.Value)) < "end" Then Do While LCase(Trim(rng1.Value)) < "end" _ And rng1.Row < 1 Set rng1 = rng1.Offset(-1, 0) Loop End If On Error Resume Next Set rng2 = Columns(1).SpecialCells(xlBlanks) On Error GoTo 0 If rng2 Is Nothing Then MsgBox "No blank cells" Else Set rng3 = Intersect(rng2.EntireRow, _ Range("A1", rng1).Offset(0, 4)) rng3.FormulaR1C1 = _ "=ISNUMBER(MATCH(RC[-3],ITPatches!C[-4],0))" End If End Sub Worked for me for Question 1. -- Regards, Tom Ogilvy "Sunnmann " wrote in message ... This is 2 parts and please let me know if you need anymore information. *1)* I would like to know what the code to write the funtion =ISNUMBER(MATCH(RC[-3],ITPatches!C[-4],0)) in all cels going down one column for only the rows that are not empty or until the cell in coumn a that says End. What I have right now is this: Range("E2").Select ActiveCell.FormulaR1C1 = "=ISNUMBER(MATCH(RC[-3],ITPatches!C[-4],0))" Range("F2").Select ActiveCell.FormulaR1C1 = "=ISNUMBER(MATCH(RC[-4],ITPatches!C[-4],0))" Range("G2").Select ActiveCell.FormulaR1C1 = "=ISNUMBER(MATCH(RC[-5],ITPatches!C[-4],0))" Range("E2:G2").Select Selection.AutoFill Destination:=Range("E2:G5000"), Type:=xlFillCopy Range("E2:G5000").Select ActiveWindow.ScrollRow = 4995 ActiveWindow.ScrollRow = 4989 ActiveWindow.ScrollRow = 4983 ActiveWindow.ScrollRow = 4977 ActiveWindow.ScrollRow = 4965 ActiveWindow.ScrollRow = 4941 ActiveWindow.ScrollRow = 4916 ActiveWindow.ScrollRow = 4886 ActiveWindow.ScrollRow = 4862 ActiveWindow.ScrollRow = 4814 ActiveWindow.ScrollRow = 4765 ActiveWindow.ScrollRow = 4711 ActiveWindow.ScrollRow = 4663 ActiveWindow.ScrollRow = 4614 ActiveWindow.ScrollRow = 4560 ActiveWindow.ScrollRow = 4445 ActiveWindow.ScrollRow = 4391 ActiveWindow.ScrollRow = 4324 ActiveWindow.ScrollRow = 4264 ActiveWindow.ScrollRow = 4197 ActiveWindow.ScrollRow = 4070 ActiveWindow.ScrollRow = 4004 ActiveWindow.ScrollRow = 3949 ActiveWindow.ScrollRow = 3834 ActiveWindow.ScrollRow = 3780 ActiveWindow.ScrollRow = 3738 ActiveWindow.ScrollRow = 3695 ActiveWindow.ScrollRow = 3647 ActiveWindow.ScrollRow = 3550 ActiveWindow.ScrollRow = 3508 ActiveWindow.ScrollRow = 3441 ActiveWindow.ScrollRow = 3393 ActiveWindow.ScrollRow = 3339 ActiveWindow.ScrollRow = 3218 ActiveWindow.ScrollRow = 3145 ActiveWindow.ScrollRow = 3073 ActiveWindow.ScrollRow = 2922 ActiveWindow.ScrollRow = 2843 ActiveWindow.ScrollRow = 2758 ActiveWindow.ScrollRow = 2680 ActiveWindow.ScrollRow = 2601 ActiveWindow.ScrollRow = 2529 ActiveWindow.ScrollRow = 2366 ActiveWindow.ScrollRow = 2293 ActiveWindow.ScrollRow = 2214 ActiveWindow.ScrollRow = 2069 ActiveWindow.ScrollRow = 1997 ActiveWindow.ScrollRow = 1942 ActiveWindow.ScrollRow = 1821 ActiveWindow.ScrollRow = 1755 ActiveWindow.ScrollRow = 1695 ActiveWindow.ScrollRow = 1634 ActiveWindow.ScrollRow = 1580 ActiveWindow.ScrollRow = 1525 ActiveWindow.ScrollRow = 1477 ActiveWindow.ScrollRow = 1368 ActiveWindow.ScrollRow = 1320 ActiveWindow.ScrollRow = 1271 ActiveWindow.ScrollRow = 1235 ActiveWindow.ScrollRow = 1187 ActiveWindow.ScrollRow = 1144 ActiveWindow.ScrollRow = 1102 ActiveWindow.ScrollRow = 1072 ActiveWindow.ScrollRow = 1036 ActiveWindow.ScrollRow = 999 ActiveWindow.ScrollRow = 963 ActiveWindow.ScrollRow = 921 ActiveWindow.ScrollRow = 891 ActiveWindow.ScrollRow = 854 ActiveWindow.ScrollRow = 818 ActiveWindow.ScrollRow = 788 ActiveWindow.ScrollRow = 758 ActiveWindow.ScrollRow = 721 ActiveWindow.ScrollRow = 697 ActiveWindow.ScrollRow = 673 ActiveWindow.ScrollRow = 649 ActiveWindow.ScrollRow = 619 ActiveWindow.ScrollRow = 594 ActiveWindow.ScrollRow = 570 ActiveWindow.ScrollRow = 552 ActiveWindow.ScrollRow = 528 ActiveWindow.ScrollRow = 510 ActiveWindow.ScrollRow = 486 ActiveWindow.ScrollRow = 461 ActiveWindow.ScrollRow = 443 ActiveWindow.ScrollRow = 419 ActiveWindow.ScrollRow = 401 ActiveWindow.ScrollRow = 383 ActiveWindow.ScrollRow = 371 ActiveWindow.ScrollRow = 353 ActiveWindow.ScrollRow = 334 ActiveWindow.ScrollRow = 322 ActiveWindow.ScrollRow = 310 ActiveWindow.ScrollRow = 298 ActiveWindow.ScrollRow = 280 ActiveWindow.ScrollRow = 268 ActiveWindow.ScrollRow = 262 ActiveWindow.ScrollRow = 250 ActiveWindow.ScrollRow = 244 ActiveWindow.ScrollRow = 226 ActiveWindow.ScrollRow = 214 ActiveWindow.ScrollRow = 208 ActiveWindow.ScrollRow = 195 ActiveWindow.ScrollRow = 183 ActiveWindow.ScrollRow = 171 ActiveWindow.ScrollRow = 165 ActiveWindow.ScrollRow = 159 ActiveWindow.ScrollRow = 153 ActiveWindow.ScrollRow = 135 ActiveWindow.ScrollRow = 129 ActiveWindow.ScrollRow = 123 ActiveWindow.ScrollRow = 117 ActiveWindow.ScrollRow = 105 ActiveWindow.ScrollRow = 99 ActiveWindow.ScrollRow = 93 ActiveWindow.ScrollRow = 87 ActiveWindow.ScrollRow = 81 ActiveWindow.ScrollRow = 75 ActiveWindow.ScrollRow = 68 ActiveWindow.ScrollRow = 62 ActiveWindow.ScrollRow = 56 ActiveWindow.ScrollRow = 50 ActiveWindow.ScrollRow = 44 ActiveWindow.ScrollRow = 38 ActiveWindow.ScrollRow = 32 ActiveWindow.ScrollRow = 26 ActiveWindow.ScrollRow = 20 ActiveWindow.ScrollRow = 14 ActiveWindow.ScrollRow = 8 ActiveWindow.ScrollRow = 2 Range("A1").Select What I want is to jnot have to do it 5000 rows, but do it only for the rows that are not a blank cell in coumn A. Or ic can be written until the cell in column a that sats End. For I add an the word End at the end of the txt file excel is opening. *2)* I found this next code from a link in this forum but i would like to change it around a bit: Sub Delete_Row() Dim Firstrow As Long Dim Lastrow As Long Dim Lrow As Long Dim CalcMode As Long With Application CalcMode = .Calculation Calculation = xlCalculationManual ScreenUpdating = False End With Firstrow = ActiveSheet.UsedRange.Cells(1).Row Lastrow = ActiveSheet.UsedRange.Rows.Count + Firstrow - 1 With ActiveSheet DisplayPageBreaks = False For Lrow = Lastrow To Firstrow Step -1 If IsError(.Cells(Lrow, "A").Value) Then 'Do nothing, This avoid a error if there is a error in the cell ElseIf .Cells(Lrow, "A").Value = "" Then Rows(Lrow).Delete 'This will delete each row with the Value "" in Column A, case sensitive. End If Next End With With Application ScreenUpdating = True Calculation = CalcMode End With End Sub I have changed this to delete any rows that are blank, But I think it is taking so long to run because it is deleteing all the rows after my data also, all the way down to 65,000 whatever. The last row in my daya, once again, has the word end in Column A. Is there a way to tell this to stop dleteing emtpy rows once it hits the word End? (I thank you all for your help and promise that I am slowly learning this when I find time here at work, going over 5 books of VB and such. And soon will have my work pay for me to go get a certification in this. But I thank you for helping me while i am still in my puppy state) --- Message posted from http://www.ExcelForum.com/ |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Problem with Macros in VB (2 Parts)
After rereading your post, I see you want rows that are not empty in column
A. My mistake. Also I believe you want to start in row2 rather than row1. Here is a correction. I only fill column E - I am not sure why you are filling F and G with formulas that return the same result? (in you sample code). Sub Tester1() Dim rng As Range, rng1 As Range Dim rng2 As Range Set rng = Cells(Rows.Count, 1).End(xlUp) Set rng1 = rng If LCase(Trim(rng1.Value)) < "end" Then Do While LCase(Trim(rng1.Value)) < "end" _ And rng1.Row < 1 Set rng1 = rng1.Offset(-1, 0) Loop End If On Error Resume Next Set rng2 = Columns(1).SpecialCells(xlConstants) On Error GoTo 0 If rng2 Is Nothing Then MsgBox "No blank cells" Else Set rng3 = Intersect(rng2.EntireRow, _ Range("A2", rng1).Offset(0, 4)) rng3.FormulaR1C1 = _ "=ISNUMBER(MATCH(RC[-3],ITPatches!C[-4],0))" End If End Sub ============== for question 2 Sub Delete_Row() Dim Firstrow As Long Dim Lastrow As Long Dim Lrow As Long Dim CalcMode As Long With Application CalcMode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False End With Firstrow = ActiveSheet.UsedRange.Cells(1).Row Lastrow = ActiveSheet.UsedRange.Rows.Count + Firstrow - 1 With ActiveSheet DisplayPageBreaks = False For Lrow = Lastrow To Firstrow Step -1 If IsError(.Cells(Lrow, "A").Value) Then 'Do nothing, This avoid a error if there is a error in the cell Elseif Trim(lcase(.Cells(Lrow,"A").Value)) = "end then With application .ScreenUpdating = True .Calculation = CalcMode End With Exit sub ElseIf .Cells(Lrow, "A").Value = "" Then Rows(Lrow).Delete 'This will delete each row with the Value "" in Column A, case sensitive. End If Next End With With Application .ScreenUpdating = True .Calculation = CalcMode End With End Sub -- Regards, Tom Ogilvy "Sunnmann " wrote in message ... This is 2 parts and please let me know if you need anymore information. *1)* I would like to know what the code to write the funtion =ISNUMBER(MATCH(RC[-3],ITPatches!C[-4],0)) in all cels going down one column for only the rows that are not empty or until the cell in coumn a that says End. What I have right now is this: Range("E2").Select ActiveCell.FormulaR1C1 = "=ISNUMBER(MATCH(RC[-3],ITPatches!C[-4],0))" Range("F2").Select ActiveCell.FormulaR1C1 = "=ISNUMBER(MATCH(RC[-4],ITPatches!C[-4],0))" Range("G2").Select ActiveCell.FormulaR1C1 = "=ISNUMBER(MATCH(RC[-5],ITPatches!C[-4],0))" Range("E2:G2").Select Selection.AutoFill Destination:=Range("E2:G5000"), Type:=xlFillCopy Range("E2:G5000").Select ActiveWindow.ScrollRow = 4995 ActiveWindow.ScrollRow = 4989 ActiveWindow.ScrollRow = 4983 ActiveWindow.ScrollRow = 4977 ActiveWindow.ScrollRow = 4965 ActiveWindow.ScrollRow = 4941 ActiveWindow.ScrollRow = 4916 ActiveWindow.ScrollRow = 4886 ActiveWindow.ScrollRow = 4862 ActiveWindow.ScrollRow = 4814 ActiveWindow.ScrollRow = 4765 ActiveWindow.ScrollRow = 4711 ActiveWindow.ScrollRow = 4663 ActiveWindow.ScrollRow = 4614 ActiveWindow.ScrollRow = 4560 ActiveWindow.ScrollRow = 4445 ActiveWindow.ScrollRow = 4391 ActiveWindow.ScrollRow = 4324 ActiveWindow.ScrollRow = 4264 ActiveWindow.ScrollRow = 4197 ActiveWindow.ScrollRow = 4070 ActiveWindow.ScrollRow = 4004 ActiveWindow.ScrollRow = 3949 ActiveWindow.ScrollRow = 3834 ActiveWindow.ScrollRow = 3780 ActiveWindow.ScrollRow = 3738 ActiveWindow.ScrollRow = 3695 ActiveWindow.ScrollRow = 3647 ActiveWindow.ScrollRow = 3550 ActiveWindow.ScrollRow = 3508 ActiveWindow.ScrollRow = 3441 ActiveWindow.ScrollRow = 3393 ActiveWindow.ScrollRow = 3339 ActiveWindow.ScrollRow = 3218 ActiveWindow.ScrollRow = 3145 ActiveWindow.ScrollRow = 3073 ActiveWindow.ScrollRow = 2922 ActiveWindow.ScrollRow = 2843 ActiveWindow.ScrollRow = 2758 ActiveWindow.ScrollRow = 2680 ActiveWindow.ScrollRow = 2601 ActiveWindow.ScrollRow = 2529 ActiveWindow.ScrollRow = 2366 ActiveWindow.ScrollRow = 2293 ActiveWindow.ScrollRow = 2214 ActiveWindow.ScrollRow = 2069 ActiveWindow.ScrollRow = 1997 ActiveWindow.ScrollRow = 1942 ActiveWindow.ScrollRow = 1821 ActiveWindow.ScrollRow = 1755 ActiveWindow.ScrollRow = 1695 ActiveWindow.ScrollRow = 1634 ActiveWindow.ScrollRow = 1580 ActiveWindow.ScrollRow = 1525 ActiveWindow.ScrollRow = 1477 ActiveWindow.ScrollRow = 1368 ActiveWindow.ScrollRow = 1320 ActiveWindow.ScrollRow = 1271 ActiveWindow.ScrollRow = 1235 ActiveWindow.ScrollRow = 1187 ActiveWindow.ScrollRow = 1144 ActiveWindow.ScrollRow = 1102 ActiveWindow.ScrollRow = 1072 ActiveWindow.ScrollRow = 1036 ActiveWindow.ScrollRow = 999 ActiveWindow.ScrollRow = 963 ActiveWindow.ScrollRow = 921 ActiveWindow.ScrollRow = 891 ActiveWindow.ScrollRow = 854 ActiveWindow.ScrollRow = 818 ActiveWindow.ScrollRow = 788 ActiveWindow.ScrollRow = 758 ActiveWindow.ScrollRow = 721 ActiveWindow.ScrollRow = 697 ActiveWindow.ScrollRow = 673 ActiveWindow.ScrollRow = 649 ActiveWindow.ScrollRow = 619 ActiveWindow.ScrollRow = 594 ActiveWindow.ScrollRow = 570 ActiveWindow.ScrollRow = 552 ActiveWindow.ScrollRow = 528 ActiveWindow.ScrollRow = 510 ActiveWindow.ScrollRow = 486 ActiveWindow.ScrollRow = 461 ActiveWindow.ScrollRow = 443 ActiveWindow.ScrollRow = 419 ActiveWindow.ScrollRow = 401 ActiveWindow.ScrollRow = 383 ActiveWindow.ScrollRow = 371 ActiveWindow.ScrollRow = 353 ActiveWindow.ScrollRow = 334 ActiveWindow.ScrollRow = 322 ActiveWindow.ScrollRow = 310 ActiveWindow.ScrollRow = 298 ActiveWindow.ScrollRow = 280 ActiveWindow.ScrollRow = 268 ActiveWindow.ScrollRow = 262 ActiveWindow.ScrollRow = 250 ActiveWindow.ScrollRow = 244 ActiveWindow.ScrollRow = 226 ActiveWindow.ScrollRow = 214 ActiveWindow.ScrollRow = 208 ActiveWindow.ScrollRow = 195 ActiveWindow.ScrollRow = 183 ActiveWindow.ScrollRow = 171 ActiveWindow.ScrollRow = 165 ActiveWindow.ScrollRow = 159 ActiveWindow.ScrollRow = 153 ActiveWindow.ScrollRow = 135 ActiveWindow.ScrollRow = 129 ActiveWindow.ScrollRow = 123 ActiveWindow.ScrollRow = 117 ActiveWindow.ScrollRow = 105 ActiveWindow.ScrollRow = 99 ActiveWindow.ScrollRow = 93 ActiveWindow.ScrollRow = 87 ActiveWindow.ScrollRow = 81 ActiveWindow.ScrollRow = 75 ActiveWindow.ScrollRow = 68 ActiveWindow.ScrollRow = 62 ActiveWindow.ScrollRow = 56 ActiveWindow.ScrollRow = 50 ActiveWindow.ScrollRow = 44 ActiveWindow.ScrollRow = 38 ActiveWindow.ScrollRow = 32 ActiveWindow.ScrollRow = 26 ActiveWindow.ScrollRow = 20 ActiveWindow.ScrollRow = 14 ActiveWindow.ScrollRow = 8 ActiveWindow.ScrollRow = 2 Range("A1").Select What I want is to jnot have to do it 5000 rows, but do it only for the rows that are not a blank cell in coumn A. Or ic can be written until the cell in column a that sats End. For I add an the word End at the end of the txt file excel is opening. *2)* I found this next code from a link in this forum but i would like to change it around a bit: Sub Delete_Row() Dim Firstrow As Long Dim Lastrow As Long Dim Lrow As Long Dim CalcMode As Long With Application CalcMode = .Calculation Calculation = xlCalculationManual ScreenUpdating = False End With Firstrow = ActiveSheet.UsedRange.Cells(1).Row Lastrow = ActiveSheet.UsedRange.Rows.Count + Firstrow - 1 With ActiveSheet DisplayPageBreaks = False For Lrow = Lastrow To Firstrow Step -1 If IsError(.Cells(Lrow, "A").Value) Then 'Do nothing, This avoid a error if there is a error in the cell ElseIf .Cells(Lrow, "A").Value = "" Then Rows(Lrow).Delete 'This will delete each row with the Value "" in Column A, case sensitive. End If Next End With With Application ScreenUpdating = True Calculation = CalcMode End With End Sub I have changed this to delete any rows that are blank, But I think it is taking so long to run because it is deleteing all the rows after my data also, all the way down to 65,000 whatever. The last row in my daya, once again, has the word end in Column A. Is there a way to tell this to stop dleteing emtpy rows once it hits the word End? (I thank you all for your help and promise that I am slowly learning this when I find time here at work, going over 5 books of VB and such. And soon will have my work pay for me to go get a certification in this. But I thank you for helping me while i am still in my puppy state) --- Message posted from http://www.ExcelForum.com/ |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Problem with Macros in VB (2 Parts)
So, what I get here is an error that tell sme no blank cells found. Jus
to make sure I am not going insane, I will give a bit more detail o Question 1. I have Columns A-G that i use Machine Name - Bulletin - Q Number - Product - All - High - Low Mach 1 - MS04-002 - Q234567 - MS Office - (code) - (code) - (code) Mach 2 - MS03-345 - Q654321 - MS Word - (code) - (code) - (code) Mach 3 - MS04-126 - Q098765 - MS Playa - (code) - (code) - (code) What i would like is for that code to go from Column E (the word All i in E1) and print in the functio =ISNUMBER(MATCH(RC[-3],ITPatches!C[-4],0)) all the way until column (The Machine Names) has the word End in the last row. Or until it hit a blank sell in Column A. The End is best for me, but either will work Once I can figure out how to get one column done I can do the other tw columns (F, G (High, Low are the word in row one respectively)) Did that make a bit more sense -- Message posted from http://www.ExcelForum.com |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Problem with Macros in VB (2 Parts)
Never mind, I was being syupid....it worked.
Thank you so much for the help pn this -- Message posted from http://www.ExcelForum.com |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Problem with Macros in VB (2 Parts)
for the part 2 question, I added and if condition, but it is inappropriate.
The macro loops from the last row to the first row, so if you retain the if condition I added, it would terminate the macro before it did any work. The only reason the macro would process more rows than you require would be if the used range was defined beyond the cell containing the word End. While this is possible, it is unlikely if this is an imported text file. If you have a lot of rows, including a lot of rows that need to be deleted, it can take a while to do it. There may be faster methods, but it would take greater knowledge of your data than you have provided to know if any would be applicable. -- Regards, Tom Ogilvy "Tom Ogilvy" wrote in message ... After rereading your post, I see you want rows that are not empty in column A. My mistake. Also I believe you want to start in row2 rather than row1. Here is a correction. I only fill column E - I am not sure why you are filling F and G with formulas that return the same result? (in you sample code). Sub Tester1() Dim rng As Range, rng1 As Range Dim rng2 As Range Set rng = Cells(Rows.Count, 1).End(xlUp) Set rng1 = rng If LCase(Trim(rng1.Value)) < "end" Then Do While LCase(Trim(rng1.Value)) < "end" _ And rng1.Row < 1 Set rng1 = rng1.Offset(-1, 0) Loop End If On Error Resume Next Set rng2 = Columns(1).SpecialCells(xlConstants) On Error GoTo 0 If rng2 Is Nothing Then MsgBox "No blank cells" Else Set rng3 = Intersect(rng2.EntireRow, _ Range("A2", rng1).Offset(0, 4)) rng3.FormulaR1C1 = _ "=ISNUMBER(MATCH(RC[-3],ITPatches!C[-4],0))" End If End Sub ============== for question 2 Sub Delete_Row() Dim Firstrow As Long Dim Lastrow As Long Dim Lrow As Long Dim CalcMode As Long With Application CalcMode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False End With Firstrow = ActiveSheet.UsedRange.Cells(1).Row Lastrow = ActiveSheet.UsedRange.Rows.Count + Firstrow - 1 With ActiveSheet DisplayPageBreaks = False For Lrow = Lastrow To Firstrow Step -1 If IsError(.Cells(Lrow, "A").Value) Then 'Do nothing, This avoid a error if there is a error in the cell Elseif Trim(lcase(.Cells(Lrow,"A").Value)) = "end then With application .ScreenUpdating = True .Calculation = CalcMode End With Exit sub ElseIf .Cells(Lrow, "A").Value = "" Then Rows(Lrow).Delete 'This will delete each row with the Value "" in Column A, case sensitive. End If Next End With With Application .ScreenUpdating = True .Calculation = CalcMode End With End Sub -- Regards, Tom Ogilvy "Sunnmann " wrote in message ... This is 2 parts and please let me know if you need anymore information. *1)* I would like to know what the code to write the funtion =ISNUMBER(MATCH(RC[-3],ITPatches!C[-4],0)) in all cels going down one column for only the rows that are not empty or until the cell in coumn a that says End. What I have right now is this: Range("E2").Select ActiveCell.FormulaR1C1 = "=ISNUMBER(MATCH(RC[-3],ITPatches!C[-4],0))" Range("F2").Select ActiveCell.FormulaR1C1 = "=ISNUMBER(MATCH(RC[-4],ITPatches!C[-4],0))" Range("G2").Select ActiveCell.FormulaR1C1 = "=ISNUMBER(MATCH(RC[-5],ITPatches!C[-4],0))" Range("E2:G2").Select Selection.AutoFill Destination:=Range("E2:G5000"), Type:=xlFillCopy Range("E2:G5000").Select ActiveWindow.ScrollRow = 4995 ActiveWindow.ScrollRow = 4989 ActiveWindow.ScrollRow = 4983 ActiveWindow.ScrollRow = 4977 ActiveWindow.ScrollRow = 4965 ActiveWindow.ScrollRow = 4941 ActiveWindow.ScrollRow = 4916 ActiveWindow.ScrollRow = 4886 ActiveWindow.ScrollRow = 4862 ActiveWindow.ScrollRow = 4814 ActiveWindow.ScrollRow = 4765 ActiveWindow.ScrollRow = 4711 ActiveWindow.ScrollRow = 4663 ActiveWindow.ScrollRow = 4614 ActiveWindow.ScrollRow = 4560 ActiveWindow.ScrollRow = 4445 ActiveWindow.ScrollRow = 4391 ActiveWindow.ScrollRow = 4324 ActiveWindow.ScrollRow = 4264 ActiveWindow.ScrollRow = 4197 ActiveWindow.ScrollRow = 4070 ActiveWindow.ScrollRow = 4004 ActiveWindow.ScrollRow = 3949 ActiveWindow.ScrollRow = 3834 ActiveWindow.ScrollRow = 3780 ActiveWindow.ScrollRow = 3738 ActiveWindow.ScrollRow = 3695 ActiveWindow.ScrollRow = 3647 ActiveWindow.ScrollRow = 3550 ActiveWindow.ScrollRow = 3508 ActiveWindow.ScrollRow = 3441 ActiveWindow.ScrollRow = 3393 ActiveWindow.ScrollRow = 3339 ActiveWindow.ScrollRow = 3218 ActiveWindow.ScrollRow = 3145 ActiveWindow.ScrollRow = 3073 ActiveWindow.ScrollRow = 2922 ActiveWindow.ScrollRow = 2843 ActiveWindow.ScrollRow = 2758 ActiveWindow.ScrollRow = 2680 ActiveWindow.ScrollRow = 2601 ActiveWindow.ScrollRow = 2529 ActiveWindow.ScrollRow = 2366 ActiveWindow.ScrollRow = 2293 ActiveWindow.ScrollRow = 2214 ActiveWindow.ScrollRow = 2069 ActiveWindow.ScrollRow = 1997 ActiveWindow.ScrollRow = 1942 ActiveWindow.ScrollRow = 1821 ActiveWindow.ScrollRow = 1755 ActiveWindow.ScrollRow = 1695 ActiveWindow.ScrollRow = 1634 ActiveWindow.ScrollRow = 1580 ActiveWindow.ScrollRow = 1525 ActiveWindow.ScrollRow = 1477 ActiveWindow.ScrollRow = 1368 ActiveWindow.ScrollRow = 1320 ActiveWindow.ScrollRow = 1271 ActiveWindow.ScrollRow = 1235 ActiveWindow.ScrollRow = 1187 ActiveWindow.ScrollRow = 1144 ActiveWindow.ScrollRow = 1102 ActiveWindow.ScrollRow = 1072 ActiveWindow.ScrollRow = 1036 ActiveWindow.ScrollRow = 999 ActiveWindow.ScrollRow = 963 ActiveWindow.ScrollRow = 921 ActiveWindow.ScrollRow = 891 ActiveWindow.ScrollRow = 854 ActiveWindow.ScrollRow = 818 ActiveWindow.ScrollRow = 788 ActiveWindow.ScrollRow = 758 ActiveWindow.ScrollRow = 721 ActiveWindow.ScrollRow = 697 ActiveWindow.ScrollRow = 673 ActiveWindow.ScrollRow = 649 ActiveWindow.ScrollRow = 619 ActiveWindow.ScrollRow = 594 ActiveWindow.ScrollRow = 570 ActiveWindow.ScrollRow = 552 ActiveWindow.ScrollRow = 528 ActiveWindow.ScrollRow = 510 ActiveWindow.ScrollRow = 486 ActiveWindow.ScrollRow = 461 ActiveWindow.ScrollRow = 443 ActiveWindow.ScrollRow = 419 ActiveWindow.ScrollRow = 401 ActiveWindow.ScrollRow = 383 ActiveWindow.ScrollRow = 371 ActiveWindow.ScrollRow = 353 ActiveWindow.ScrollRow = 334 ActiveWindow.ScrollRow = 322 ActiveWindow.ScrollRow = 310 ActiveWindow.ScrollRow = 298 ActiveWindow.ScrollRow = 280 ActiveWindow.ScrollRow = 268 ActiveWindow.ScrollRow = 262 ActiveWindow.ScrollRow = 250 ActiveWindow.ScrollRow = 244 ActiveWindow.ScrollRow = 226 ActiveWindow.ScrollRow = 214 ActiveWindow.ScrollRow = 208 ActiveWindow.ScrollRow = 195 ActiveWindow.ScrollRow = 183 ActiveWindow.ScrollRow = 171 ActiveWindow.ScrollRow = 165 ActiveWindow.ScrollRow = 159 ActiveWindow.ScrollRow = 153 ActiveWindow.ScrollRow = 135 ActiveWindow.ScrollRow = 129 ActiveWindow.ScrollRow = 123 ActiveWindow.ScrollRow = 117 ActiveWindow.ScrollRow = 105 ActiveWindow.ScrollRow = 99 ActiveWindow.ScrollRow = 93 ActiveWindow.ScrollRow = 87 ActiveWindow.ScrollRow = 81 ActiveWindow.ScrollRow = 75 ActiveWindow.ScrollRow = 68 ActiveWindow.ScrollRow = 62 ActiveWindow.ScrollRow = 56 ActiveWindow.ScrollRow = 50 ActiveWindow.ScrollRow = 44 ActiveWindow.ScrollRow = 38 ActiveWindow.ScrollRow = 32 ActiveWindow.ScrollRow = 26 ActiveWindow.ScrollRow = 20 ActiveWindow.ScrollRow = 14 ActiveWindow.ScrollRow = 8 ActiveWindow.ScrollRow = 2 Range("A1").Select What I want is to jnot have to do it 5000 rows, but do it only for the rows that are not a blank cell in coumn A. Or ic can be written until the cell in column a that sats End. For I add an the word End at the end of the txt file excel is opening. *2)* I found this next code from a link in this forum but i would like to change it around a bit: Sub Delete_Row() Dim Firstrow As Long Dim Lastrow As Long Dim Lrow As Long Dim CalcMode As Long With Application CalcMode = .Calculation Calculation = xlCalculationManual ScreenUpdating = False End With Firstrow = ActiveSheet.UsedRange.Cells(1).Row Lastrow = ActiveSheet.UsedRange.Rows.Count + Firstrow - 1 With ActiveSheet DisplayPageBreaks = False For Lrow = Lastrow To Firstrow Step -1 If IsError(.Cells(Lrow, "A").Value) Then 'Do nothing, This avoid a error if there is a error in the cell ElseIf .Cells(Lrow, "A").Value = "" Then Rows(Lrow).Delete 'This will delete each row with the Value "" in Column A, case sensitive. End If Next End With With Application ScreenUpdating = True Calculation = CalcMode End With End Sub I have changed this to delete any rows that are blank, But I think it is taking so long to run because it is deleteing all the rows after my data also, all the way down to 65,000 whatever. The last row in my daya, once again, has the word end in Column A. Is there a way to tell this to stop dleteing emtpy rows once it hits the word End? (I thank you all for your help and promise that I am slowly learning this when I find time here at work, going over 5 books of VB and such. And soon will have my work pay for me to go get a certification in this. But I thank you for helping me while i am still in my puppy state) --- Message posted from http://www.ExcelForum.com/ |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Problem with Macros | Excel Discussion (Misc queries) | |||
Macros Problem | Excel Discussion (Misc queries) | |||
Problem Assigning Macros | Excel Worksheet Functions | |||
Problem with running Macros | Excel Discussion (Misc queries) | |||
Problem with macros on Mac | Excel Programming |