Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Find same value in continuous Cells
Hi,
I need to find 4 cells in the same column that have the same value, 4. I need to save the row so I can use it as the end of my print range. Here is what I have so far but it's not working. Can anyone help? Sub PrintDoc() Dim LastRow As Integer 'Last Row of Printing Range Dim FirstAddress As Range 'First found occurance of a match Dim NextAddress As Range ' Next occurance of a match Dim X As Integer 'counter X = 0 'set counter to 0 With ActiveSheet.Range("E36:E336") Set c = .Find(0, LookIn:=xlValues) If Not c Is Nothing Then FirstAddress = c.Address Do NextAddress = c.Address If NextAddress = FirstAddress + 1 Then ' are the matches continuous? X = X + 1 'increment the counter LastRow = NextAddress - 4 'save the row location Set c = .FindNext(c) End If Loop While Not c Is Nothing And X < 4 End If End With Range("E1:" & "O" & LastRow).Select Selection.PrintOut Copies:=1, Collate:=True End Sub Thanks |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Find same value in continuous Cells
Sub PrintDoc()
Dim Lastrow As Integer 'Last Row of Printing Range Dim FirstAddress As String 'First found occurance of a match Dim X As Integer 'counter X = 0 'set counter to 0 With ActiveSheet.Range("E36:E336") Set c = .Find(0, LookIn:=xlValues) If Not c Is Nothing Then FirstAddress = c.Address Lastrow = c.Row X = X + 1 Set c = .FindNext(c) Do While Not (c Is Nothing) And _ (c.Address < FirstAddress) And X < 4 If c.Row = Lastrow + 1 Then ' are the 'matches continuous? X = X + 1 'increment the counter Lastrow = c.Row 'save the row location Else X = 0 End If Set c = .FindNext(c) Loop End If End With Range("E1:" & "O" & Lastrow).Select Selection.PrintOut Copies:=1, Collate:=True End Sub "Karen53" wrote: Hi, I need to find 4 cells in the same column that have the same value, 4. I need to save the row so I can use it as the end of my print range. Here is what I have so far but it's not working. Can anyone help? Sub PrintDoc() Dim LastRow As Integer 'Last Row of Printing Range Dim FirstAddress As Range 'First found occurance of a match Dim NextAddress As Range ' Next occurance of a match Dim X As Integer 'counter X = 0 'set counter to 0 With ActiveSheet.Range("E36:E336") Set c = .Find(0, LookIn:=xlValues) If Not c Is Nothing Then FirstAddress = c.Address Do NextAddress = c.Address If NextAddress = FirstAddress + 1 Then ' are the matches continuous? X = X + 1 'increment the counter LastRow = NextAddress - 4 'save the row location Set c = .FindNext(c) End If Loop While Not c Is Nothing And X < 4 End If End With Range("E1:" & "O" & LastRow).Select Selection.PrintOut Copies:=1, Collate:=True End Sub Thanks |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Find same value in continuous Cells
Thanks Joel,
I've tried the code below but it only prints the first 5 lines below E36. The X counter was to count the number of continuous cells containing the value zero. So once there are 4 continuous cells containing zero, I need the first cell of that 4 zero set to be the LastRow. The range does not hit a value of zero until much later. Am I missing something? Thanks. "Joel" wrote: Sub PrintDoc() Dim Lastrow As Integer 'Last Row of Printing Range Dim FirstAddress As String 'First found occurance of a match Dim X As Integer 'counter X = 0 'set counter to 0 With ActiveSheet.Range("E36:E336") Set c = .Find(0, LookIn:=xlValues) If Not c Is Nothing Then FirstAddress = c.Address Lastrow = c.Row X = X + 1 Set c = .FindNext(c) Do While Not (c Is Nothing) And _ (c.Address < FirstAddress) And X < 4 If c.Row = Lastrow + 1 Then ' are the 'matches continuous? X = X + 1 'increment the counter Lastrow = c.Row 'save the row location Else X = 0 End If Set c = .FindNext(c) Loop End If End With Range("E1:" & "O" & Lastrow).Select Selection.PrintOut Copies:=1, Collate:=True End Sub "Karen53" wrote: Hi, I need to find 4 cells in the same column that have the same value, 4. I need to save the row so I can use it as the end of my print range. Here is what I have so far but it's not working. Can anyone help? Sub PrintDoc() Dim LastRow As Integer 'Last Row of Printing Range Dim FirstAddress As Range 'First found occurance of a match Dim NextAddress As Range ' Next occurance of a match Dim X As Integer 'counter X = 0 'set counter to 0 With ActiveSheet.Range("E36:E336") Set c = .Find(0, LookIn:=xlValues) If Not c Is Nothing Then FirstAddress = c.Address Do NextAddress = c.Address If NextAddress = FirstAddress + 1 Then ' are the matches continuous? X = X + 1 'increment the counter LastRow = NextAddress - 4 'save the row location Set c = .FindNext(c) End If Loop While Not c Is Nothing And X < 4 End If End With Range("E1:" & "O" & LastRow).Select Selection.PrintOut Copies:=1, Collate:=True End Sub Thanks |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Find same value in continuous Cells
I wasn't sure from your code if I needed to subtract 4.
just change the following from Range("E1:" & "O" & Lastrow).Select to Range("E1:" & "O" & (Lastrow - 4)).Select "Karen53" wrote: Thanks Joel, I've tried the code below but it only prints the first 5 lines below E36. The X counter was to count the number of continuous cells containing the value zero. So once there are 4 continuous cells containing zero, I need the first cell of that 4 zero set to be the LastRow. The range does not hit a value of zero until much later. Am I missing something? Thanks. "Joel" wrote: Sub PrintDoc() Dim Lastrow As Integer 'Last Row of Printing Range Dim FirstAddress As String 'First found occurance of a match Dim X As Integer 'counter X = 0 'set counter to 0 With ActiveSheet.Range("E36:E336") Set c = .Find(0, LookIn:=xlValues) If Not c Is Nothing Then FirstAddress = c.Address Lastrow = c.Row X = X + 1 Set c = .FindNext(c) Do While Not (c Is Nothing) And _ (c.Address < FirstAddress) And X < 4 If c.Row = Lastrow + 1 Then ' are the 'matches continuous? X = X + 1 'increment the counter Lastrow = c.Row 'save the row location Else X = 0 End If Set c = .FindNext(c) Loop End If End With Range("E1:" & "O" & Lastrow).Select Selection.PrintOut Copies:=1, Collate:=True End Sub "Karen53" wrote: Hi, I need to find 4 cells in the same column that have the same value, 4. I need to save the row so I can use it as the end of my print range. Here is what I have so far but it's not working. Can anyone help? Sub PrintDoc() Dim LastRow As Integer 'Last Row of Printing Range Dim FirstAddress As Range 'First found occurance of a match Dim NextAddress As Range ' Next occurance of a match Dim X As Integer 'counter X = 0 'set counter to 0 With ActiveSheet.Range("E36:E336") Set c = .Find(0, LookIn:=xlValues) If Not c Is Nothing Then FirstAddress = c.Address Do NextAddress = c.Address If NextAddress = FirstAddress + 1 Then ' are the matches continuous? X = X + 1 'increment the counter LastRow = NextAddress - 4 'save the row location Set c = .FindNext(c) End If Loop While Not c Is Nothing And X < 4 End If End With Range("E1:" & "O" & LastRow).Select Selection.PrintOut Copies:=1, Collate:=True End Sub Thanks |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Find same value in continuous Cells
Hi Joel,
I made the change but now I only get one line below E36. Somehow it is not getting to the zero values. I double checked my cells. The first zero value in this sheet occurs at E81 but it's only one, the next cell is non-zero. The 4 cells together containing a zero value start at E93. Any ideas? Thanks "Joel" wrote: I wasn't sure from your code if I needed to subtract 4. just change the following from Range("E1:" & "O" & Lastrow).Select to Range("E1:" & "O" & (Lastrow - 4)).Select "Karen53" wrote: Thanks Joel, I've tried the code below but it only prints the first 5 lines below E36. The X counter was to count the number of continuous cells containing the value zero. So once there are 4 continuous cells containing zero, I need the first cell of that 4 zero set to be the LastRow. The range does not hit a value of zero until much later. Am I missing something? Thanks. "Joel" wrote: Sub PrintDoc() Dim Lastrow As Integer 'Last Row of Printing Range Dim FirstAddress As String 'First found occurance of a match Dim X As Integer 'counter X = 0 'set counter to 0 With ActiveSheet.Range("E36:E336") Set c = .Find(0, LookIn:=xlValues) If Not c Is Nothing Then FirstAddress = c.Address Lastrow = c.Row X = X + 1 Set c = .FindNext(c) Do While Not (c Is Nothing) And _ (c.Address < FirstAddress) And X < 4 If c.Row = Lastrow + 1 Then ' are the 'matches continuous? X = X + 1 'increment the counter Lastrow = c.Row 'save the row location Else X = 0 End If Set c = .FindNext(c) Loop End If End With Range("E1:" & "O" & Lastrow).Select Selection.PrintOut Copies:=1, Collate:=True End Sub "Karen53" wrote: Hi, I need to find 4 cells in the same column that have the same value, 4. I need to save the row so I can use it as the end of my print range. Here is what I have so far but it's not working. Can anyone help? Sub PrintDoc() Dim LastRow As Integer 'Last Row of Printing Range Dim FirstAddress As Range 'First found occurance of a match Dim NextAddress As Range ' Next occurance of a match Dim X As Integer 'counter X = 0 'set counter to 0 With ActiveSheet.Range("E36:E336") Set c = .Find(0, LookIn:=xlValues) If Not c Is Nothing Then FirstAddress = c.Address Do NextAddress = c.Address If NextAddress = FirstAddress + 1 Then ' are the matches continuous? X = X + 1 'increment the counter LastRow = NextAddress - 4 'save the row location Set c = .FindNext(c) End If Loop While Not c Is Nothing And X < 4 End If End With Range("E1:" & "O" & LastRow).Select Selection.PrintOut Copies:=1, Collate:=True End Sub Thanks |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Find same value in continuous Cells
HI,
I;ve been stepping through it and it looks like it is counting the cells with values other that zero but I don't know how to reverse it. "Joel" wrote: I wasn't sure from your code if I needed to subtract 4. just change the following from Range("E1:" & "O" & Lastrow).Select to Range("E1:" & "O" & (Lastrow - 4)).Select "Karen53" wrote: Thanks Joel, I've tried the code below but it only prints the first 5 lines below E36. The X counter was to count the number of continuous cells containing the value zero. So once there are 4 continuous cells containing zero, I need the first cell of that 4 zero set to be the LastRow. The range does not hit a value of zero until much later. Am I missing something? Thanks. "Joel" wrote: Sub PrintDoc() Dim Lastrow As Integer 'Last Row of Printing Range Dim FirstAddress As String 'First found occurance of a match Dim X As Integer 'counter X = 0 'set counter to 0 With ActiveSheet.Range("E36:E336") Set c = .Find(0, LookIn:=xlValues) If Not c Is Nothing Then FirstAddress = c.Address Lastrow = c.Row X = X + 1 Set c = .FindNext(c) Do While Not (c Is Nothing) And _ (c.Address < FirstAddress) And X < 4 If c.Row = Lastrow + 1 Then ' are the 'matches continuous? X = X + 1 'increment the counter Lastrow = c.Row 'save the row location Else X = 0 End If Set c = .FindNext(c) Loop End If End With Range("E1:" & "O" & Lastrow).Select Selection.PrintOut Copies:=1, Collate:=True End Sub "Karen53" wrote: Hi, I need to find 4 cells in the same column that have the same value, 4. I need to save the row so I can use it as the end of my print range. Here is what I have so far but it's not working. Can anyone help? Sub PrintDoc() Dim LastRow As Integer 'Last Row of Printing Range Dim FirstAddress As Range 'First found occurance of a match Dim NextAddress As Range ' Next occurance of a match Dim X As Integer 'counter X = 0 'set counter to 0 With ActiveSheet.Range("E36:E336") Set c = .Find(0, LookIn:=xlValues) If Not c Is Nothing Then FirstAddress = c.Address Do NextAddress = c.Address If NextAddress = FirstAddress + 1 Then ' are the matches continuous? X = X + 1 'increment the counter LastRow = NextAddress - 4 'save the row location Set c = .FindNext(c) End If Loop While Not c Is Nothing And X < 4 End If End With Range("E1:" & "O" & LastRow).Select Selection.PrintOut Copies:=1, Collate:=True End Sub Thanks |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Find same value in continuous Cells
Sub PrintDoc()
Dim Lastrow As Integer 'Last Row of Printing Range Dim FirstAddress As String 'First found occurance of a match Dim X As Integer 'counter X = 0 'set counter to 0 With ActiveSheet.Range("E36:E336") Set c = .Find(0, LookIn:=xlValues) If Not c Is Nothing Then FirstAddress = c.Address Lastrow = c.Row X = X + 1 Set c = .FindNext(c) Do While Not (c Is Nothing) And _ (c.Address < FirstAddress) And X < 4 If c.Row = Lastrow + 1 Then ' are the 'matches continuous? X = X + 1 'increment the counter Else X = 1 End If Lastrow = c.Row 'save the row location Set c = .FindNext(c) Loop End If End With Range("E1:" & "O" & (Lastrow - 4)).Select ' Selection.PrintOut Copies:=1, Collate:=True End Sub "Karen53" wrote: Hi Joel, I made the change but now I only get one line below E36. Somehow it is not getting to the zero values. I double checked my cells. The first zero value in this sheet occurs at E81 but it's only one, the next cell is non-zero. The 4 cells together containing a zero value start at E93. Any ideas? Thanks "Joel" wrote: I wasn't sure from your code if I needed to subtract 4. just change the following from Range("E1:" & "O" & Lastrow).Select to Range("E1:" & "O" & (Lastrow - 4)).Select "Karen53" wrote: Thanks Joel, I've tried the code below but it only prints the first 5 lines below E36. The X counter was to count the number of continuous cells containing the value zero. So once there are 4 continuous cells containing zero, I need the first cell of that 4 zero set to be the LastRow. The range does not hit a value of zero until much later. Am I missing something? Thanks. "Joel" wrote: Sub PrintDoc() Dim Lastrow As Integer 'Last Row of Printing Range Dim FirstAddress As String 'First found occurance of a match Dim X As Integer 'counter X = 0 'set counter to 0 With ActiveSheet.Range("E36:E336") Set c = .Find(0, LookIn:=xlValues) If Not c Is Nothing Then FirstAddress = c.Address Lastrow = c.Row X = X + 1 Set c = .FindNext(c) Do While Not (c Is Nothing) And _ (c.Address < FirstAddress) And X < 4 If c.Row = Lastrow + 1 Then ' are the 'matches continuous? X = X + 1 'increment the counter Lastrow = c.Row 'save the row location Else X = 0 End If Set c = .FindNext(c) Loop End If End With Range("E1:" & "O" & Lastrow).Select Selection.PrintOut Copies:=1, Collate:=True End Sub "Karen53" wrote: Hi, I need to find 4 cells in the same column that have the same value, 4. I need to save the row so I can use it as the end of my print range. Here is what I have so far but it's not working. Can anyone help? Sub PrintDoc() Dim LastRow As Integer 'Last Row of Printing Range Dim FirstAddress As Range 'First found occurance of a match Dim NextAddress As Range ' Next occurance of a match Dim X As Integer 'counter X = 0 'set counter to 0 With ActiveSheet.Range("E36:E336") Set c = .Find(0, LookIn:=xlValues) If Not c Is Nothing Then FirstAddress = c.Address Do NextAddress = c.Address If NextAddress = FirstAddress + 1 Then ' are the matches continuous? X = X + 1 'increment the counter LastRow = NextAddress - 4 'save the row location Set c = .FindNext(c) End If Loop While Not c Is Nothing And X < 4 End If End With Range("E1:" & "O" & LastRow).Select Selection.PrintOut Copies:=1, Collate:=True End Sub Thanks |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Find same value in continuous Cells
No, It's still not working. Is there anything else I may not be realizing?
"Karen53" wrote: HI, I;ve been stepping through it and it looks like it is counting the cells with values other that zero but I don't know how to reverse it. "Joel" wrote: I wasn't sure from your code if I needed to subtract 4. just change the following from Range("E1:" & "O" & Lastrow).Select to Range("E1:" & "O" & (Lastrow - 4)).Select "Karen53" wrote: Thanks Joel, I've tried the code below but it only prints the first 5 lines below E36. The X counter was to count the number of continuous cells containing the value zero. So once there are 4 continuous cells containing zero, I need the first cell of that 4 zero set to be the LastRow. The range does not hit a value of zero until much later. Am I missing something? Thanks. "Joel" wrote: Sub PrintDoc() Dim Lastrow As Integer 'Last Row of Printing Range Dim FirstAddress As String 'First found occurance of a match Dim X As Integer 'counter X = 0 'set counter to 0 With ActiveSheet.Range("E36:E336") Set c = .Find(0, LookIn:=xlValues) If Not c Is Nothing Then FirstAddress = c.Address Lastrow = c.Row X = X + 1 Set c = .FindNext(c) Do While Not (c Is Nothing) And _ (c.Address < FirstAddress) And X < 4 If c.Row = Lastrow + 1 Then ' are the 'matches continuous? X = X + 1 'increment the counter Lastrow = c.Row 'save the row location Else X = 0 End If Set c = .FindNext(c) Loop End If End With Range("E1:" & "O" & Lastrow).Select Selection.PrintOut Copies:=1, Collate:=True End Sub "Karen53" wrote: Hi, I need to find 4 cells in the same column that have the same value, 4. I need to save the row so I can use it as the end of my print range. Here is what I have so far but it's not working. Can anyone help? Sub PrintDoc() Dim LastRow As Integer 'Last Row of Printing Range Dim FirstAddress As Range 'First found occurance of a match Dim NextAddress As Range ' Next occurance of a match Dim X As Integer 'counter X = 0 'set counter to 0 With ActiveSheet.Range("E36:E336") Set c = .Find(0, LookIn:=xlValues) If Not c Is Nothing Then FirstAddress = c.Address Do NextAddress = c.Address If NextAddress = FirstAddress + 1 Then ' are the matches continuous? X = X + 1 'increment the counter LastRow = NextAddress - 4 'save the row location Set c = .FindNext(c) End If Loop While Not c Is Nothing And X < 4 End If End With Range("E1:" & "O" & LastRow).Select Selection.PrintOut Copies:=1, Collate:=True End Sub Thanks |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
Find same value in continuous Cells
You meant to write that you're looking for 4 consecutive 0's, right?
How about: Option Explicit Sub PrintDoc() Dim LastRow As Long Dim FirstAddress As String Dim FoundCell As Range Dim wks As Worksheet Dim WhatToFind As Variant 'string is ok here Set wks = ActiveSheet WhatToFind = 0 LastRow = 0 With wks 'check the bottom of column E??? 'With .Range("e36:e" & .Cells(.Rows.Count, "E").End(xlUp).Row) With .Range("E36:E336") Set FoundCell = .Find(What:=WhatToFind, _ after:=.Cells(.Cells.Count), _ LookIn:=xlFormulas, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If FoundCell Is Nothing Then MsgBox "no 0's in that range!" Exit Sub Else FirstAddress = FoundCell.Address Do If Application.CountIf(FoundCell.Resize(4, 1), _ WhatToFind) = 4 Then 'found it!! LastRow = FoundCell.Row Exit Do Else 'keep looking Set FoundCell = .FindNext(after:=FoundCell) If FoundCell.Address = FirstAddress Then 'back at the top, get out Exit Do End If End If Loop End If End With If LastRow = 0 Then MsgBox "No group of 4 0's found!" Else 'MsgBox .Range("E1:O" & LastRow).Address .Range("E1:O" & LastRow).PrintOut preview:=True 'nice for testing End If End With End Sub ps. .find is one of those VBA methods that shares its parameters with the user. If the user does Edit|Find and wants to search for 0 (xlpart rather than xlwhole), then your code may find lots of intermediate 0's and essentially waste time looking when it doesn't have to. It's always better to specify all those .find parms than to take a chance. (Especially with text (think matching case not what you expect) could cause a debugging nightmare.) Karen53 wrote: Hi, I need to find 4 cells in the same column that have the same value, 4. I need to save the row so I can use it as the end of my print range. Here is what I have so far but it's not working. Can anyone help? Sub PrintDoc() Dim LastRow As Integer 'Last Row of Printing Range Dim FirstAddress As Range 'First found occurance of a match Dim NextAddress As Range ' Next occurance of a match Dim X As Integer 'counter X = 0 'set counter to 0 With ActiveSheet.Range("E36:E336") Set c = .Find(0, LookIn:=xlValues) If Not c Is Nothing Then FirstAddress = c.Address Do NextAddress = c.Address If NextAddress = FirstAddress + 1 Then ' are the matches continuous? X = X + 1 'increment the counter LastRow = NextAddress - 4 'save the row location Set c = .FindNext(c) End If Loop While Not c Is Nothing And X < 4 End If End With Range("E1:" & "O" & LastRow).Select Selection.PrintOut Copies:=1, Collate:=True End Sub Thanks -- Dave Peterson |
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
Find same value in continuous Cells
Hi Dave,
Thanks for your response. Yes, I am trying to find 4 consecutive cells containing the value 0. I haven't tried it yet but looking at what you wrote made me realize what has been happening. My cells contain alpha-numeric values all of which are loaded with 0. So what I'm really looking for is those cells which contain 0 alone, no extra characters. Unfortunately, I can't look for blank because the cells contain formulas and are not 'blank'. I need to find the end of the data from these formulas, many of which are not used all the time. Would you procedure below work in this situation? I feel doomed. Is there a way around this? Thank you for your help. "Dave Peterson" wrote: You meant to write that you're looking for 4 consecutive 0's, right? How about: Option Explicit Sub PrintDoc() Dim LastRow As Long Dim FirstAddress As String Dim FoundCell As Range Dim wks As Worksheet Dim WhatToFind As Variant 'string is ok here Set wks = ActiveSheet WhatToFind = 0 LastRow = 0 With wks 'check the bottom of column E??? 'With .Range("e36:e" & .Cells(.Rows.Count, "E").End(xlUp).Row) With .Range("E36:E336") Set FoundCell = .Find(What:=WhatToFind, _ after:=.Cells(.Cells.Count), _ LookIn:=xlFormulas, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If FoundCell Is Nothing Then MsgBox "no 0's in that range!" Exit Sub Else FirstAddress = FoundCell.Address Do If Application.CountIf(FoundCell.Resize(4, 1), _ WhatToFind) = 4 Then 'found it!! LastRow = FoundCell.Row Exit Do Else 'keep looking Set FoundCell = .FindNext(after:=FoundCell) If FoundCell.Address = FirstAddress Then 'back at the top, get out Exit Do End If End If Loop End If End With If LastRow = 0 Then MsgBox "No group of 4 0's found!" Else 'MsgBox .Range("E1:O" & LastRow).Address .Range("E1:O" & LastRow).PrintOut preview:=True 'nice for testing End If End With End Sub ps. .find is one of those VBA methods that shares its parameters with the user. If the user does Edit|Find and wants to search for 0 (xlpart rather than xlwhole), then your code may find lots of intermediate 0's and essentially waste time looking when it doesn't have to. It's always better to specify all those .find parms than to take a chance. (Especially with text (think matching case not what you expect) could cause a debugging nightmare.) Karen53 wrote: Hi, I need to find 4 cells in the same column that have the same value, 4. I need to save the row so I can use it as the end of my print range. Here is what I have so far but it's not working. Can anyone help? Sub PrintDoc() Dim LastRow As Integer 'Last Row of Printing Range Dim FirstAddress As Range 'First found occurance of a match Dim NextAddress As Range ' Next occurance of a match Dim X As Integer 'counter X = 0 'set counter to 0 With ActiveSheet.Range("E36:E336") Set c = .Find(0, LookIn:=xlValues) If Not c Is Nothing Then FirstAddress = c.Address Do NextAddress = c.Address If NextAddress = FirstAddress + 1 Then ' are the matches continuous? X = X + 1 'increment the counter LastRow = NextAddress - 4 'save the row location Set c = .FindNext(c) End If Loop While Not c Is Nothing And X < 4 End If End With Range("E1:" & "O" & LastRow).Select Selection.PrintOut Copies:=1, Collate:=True End Sub Thanks -- Dave Peterson |
#11
Posted to microsoft.public.excel.programming
|
|||
|
|||
Find same value in continuous Cells
If you're really looking for 4 consecutive 0's, then try it.
If you want to treat blanks (formulas that evaluate to ""), then the code would need to change. If 4 was just an arbitrary number that you figured would be enough to "guess" that you were at the end of the "real" data, I'd just loop from the bottom up looking for a non-zero value. Dim LastRow as long dim iRow as long Dim TopRow as Long Dim BottomRow as long with worksheets("whatever") lastRow = 0 Toprow = 36 bottomrow = .cells(.rows.count,"E").end(xlup).row for irow = bottomrow to toprow step -1 'I used text to avoid any empty cells if .cells(irow,"E").text = "0" then 'keep looking else lastrow = irow exit for end if next irow if lastrow = 0 then 'all 0's, what should happen else 'do the print end if end with Your original range was E36:E336. You'll be surprised at how fast your code loops through those rows--you won't notice a problem. (You may notice a severe delay if you start at row 1,000,000 (xl2007) or 65,536 (xl2003) and find the first row is close to row 36, though.) Karen53 wrote: Hi Dave, Thanks for your response. Yes, I am trying to find 4 consecutive cells containing the value 0. I haven't tried it yet but looking at what you wrote made me realize what has been happening. My cells contain alpha-numeric values all of which are loaded with 0. So what I'm really looking for is those cells which contain 0 alone, no extra characters. Unfortunately, I can't look for blank because the cells contain formulas and are not 'blank'. I need to find the end of the data from these formulas, many of which are not used all the time. Would you procedure below work in this situation? I feel doomed. Is there a way around this? Thank you for your help. "Dave Peterson" wrote: You meant to write that you're looking for 4 consecutive 0's, right? How about: Option Explicit Sub PrintDoc() Dim LastRow As Long Dim FirstAddress As String Dim FoundCell As Range Dim wks As Worksheet Dim WhatToFind As Variant 'string is ok here Set wks = ActiveSheet WhatToFind = 0 LastRow = 0 With wks 'check the bottom of column E??? 'With .Range("e36:e" & .Cells(.Rows.Count, "E").End(xlUp).Row) With .Range("E36:E336") Set FoundCell = .Find(What:=WhatToFind, _ after:=.Cells(.Cells.Count), _ LookIn:=xlFormulas, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If FoundCell Is Nothing Then MsgBox "no 0's in that range!" Exit Sub Else FirstAddress = FoundCell.Address Do If Application.CountIf(FoundCell.Resize(4, 1), _ WhatToFind) = 4 Then 'found it!! LastRow = FoundCell.Row Exit Do Else 'keep looking Set FoundCell = .FindNext(after:=FoundCell) If FoundCell.Address = FirstAddress Then 'back at the top, get out Exit Do End If End If Loop End If End With If LastRow = 0 Then MsgBox "No group of 4 0's found!" Else 'MsgBox .Range("E1:O" & LastRow).Address .Range("E1:O" & LastRow).PrintOut preview:=True 'nice for testing End If End With End Sub ps. .find is one of those VBA methods that shares its parameters with the user. If the user does Edit|Find and wants to search for 0 (xlpart rather than xlwhole), then your code may find lots of intermediate 0's and essentially waste time looking when it doesn't have to. It's always better to specify all those .find parms than to take a chance. (Especially with text (think matching case not what you expect) could cause a debugging nightmare.) Karen53 wrote: Hi, I need to find 4 cells in the same column that have the same value, 4. I need to save the row so I can use it as the end of my print range. Here is what I have so far but it's not working. Can anyone help? Sub PrintDoc() Dim LastRow As Integer 'Last Row of Printing Range Dim FirstAddress As Range 'First found occurance of a match Dim NextAddress As Range ' Next occurance of a match Dim X As Integer 'counter X = 0 'set counter to 0 With ActiveSheet.Range("E36:E336") Set c = .Find(0, LookIn:=xlValues) If Not c Is Nothing Then FirstAddress = c.Address Do NextAddress = c.Address If NextAddress = FirstAddress + 1 Then ' are the matches continuous? X = X + 1 'increment the counter LastRow = NextAddress - 4 'save the row location Set c = .FindNext(c) End If Loop While Not c Is Nothing And X < 4 End If End With Range("E1:" & "O" & LastRow).Select Selection.PrintOut Copies:=1, Collate:=True End Sub Thanks -- Dave Peterson -- Dave Peterson |
#12
Posted to microsoft.public.excel.programming
|
|||
|
|||
Find same value in continuous Cells
Hi Dave,
Thanks! I'm getting closer. Yes, I would be checking for "". This works if I remove the If(isblank(whatever),"",Whatever. What would the code change be for that? Also, I have code out of the way at IG3000 at work. Instead of starting at the end of the worksheet, which would end up being about 3500, would I be able to start working up at about 370? Thank you so much Dave! "Dave Peterson" wrote: If you're really looking for 4 consecutive 0's, then try it. If you want to treat blanks (formulas that evaluate to ""), then the code would need to change. If 4 was just an arbitrary number that you figured would be enough to "guess" that you were at the end of the "real" data, I'd just loop from the bottom up looking for a non-zero value. Dim LastRow as long dim iRow as long Dim TopRow as Long Dim BottomRow as long with worksheets("whatever") lastRow = 0 Toprow = 36 bottomrow = .cells(.rows.count,"E").end(xlup).row for irow = bottomrow to toprow step -1 'I used text to avoid any empty cells if .cells(irow,"E").text = "0" then 'keep looking else lastrow = irow exit for end if next irow if lastrow = 0 then 'all 0's, what should happen else 'do the print end if end with Your original range was E36:E336. You'll be surprised at how fast your code loops through those rows--you won't notice a problem. (You may notice a severe delay if you start at row 1,000,000 (xl2007) or 65,536 (xl2003) and find the first row is close to row 36, though.) Karen53 wrote: Hi Dave, Thanks for your response. Yes, I am trying to find 4 consecutive cells containing the value 0. I haven't tried it yet but looking at what you wrote made me realize what has been happening. My cells contain alpha-numeric values all of which are loaded with 0. So what I'm really looking for is those cells which contain 0 alone, no extra characters. Unfortunately, I can't look for blank because the cells contain formulas and are not 'blank'. I need to find the end of the data from these formulas, many of which are not used all the time. Would you procedure below work in this situation? I feel doomed. Is there a way around this? Thank you for your help. "Dave Peterson" wrote: You meant to write that you're looking for 4 consecutive 0's, right? How about: Option Explicit Sub PrintDoc() Dim LastRow As Long Dim FirstAddress As String Dim FoundCell As Range Dim wks As Worksheet Dim WhatToFind As Variant 'string is ok here Set wks = ActiveSheet WhatToFind = 0 LastRow = 0 With wks 'check the bottom of column E??? 'With .Range("e36:e" & .Cells(.Rows.Count, "E").End(xlUp).Row) With .Range("E36:E336") Set FoundCell = .Find(What:=WhatToFind, _ after:=.Cells(.Cells.Count), _ LookIn:=xlFormulas, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If FoundCell Is Nothing Then MsgBox "no 0's in that range!" Exit Sub Else FirstAddress = FoundCell.Address Do If Application.CountIf(FoundCell.Resize(4, 1), _ WhatToFind) = 4 Then 'found it!! LastRow = FoundCell.Row Exit Do Else 'keep looking Set FoundCell = .FindNext(after:=FoundCell) If FoundCell.Address = FirstAddress Then 'back at the top, get out Exit Do End If End If Loop End If End With If LastRow = 0 Then MsgBox "No group of 4 0's found!" Else 'MsgBox .Range("E1:O" & LastRow).Address .Range("E1:O" & LastRow).PrintOut preview:=True 'nice for testing End If End With End Sub ps. .find is one of those VBA methods that shares its parameters with the user. If the user does Edit|Find and wants to search for 0 (xlpart rather than xlwhole), then your code may find lots of intermediate 0's and essentially waste time looking when it doesn't have to. It's always better to specify all those .find parms than to take a chance. (Especially with text (think matching case not what you expect) could cause a debugging nightmare.) Karen53 wrote: Hi, I need to find 4 cells in the same column that have the same value, 4. I need to save the row so I can use it as the end of my print range. Here is what I have so far but it's not working. Can anyone help? Sub PrintDoc() Dim LastRow As Integer 'Last Row of Printing Range Dim FirstAddress As Range 'First found occurance of a match Dim NextAddress As Range ' Next occurance of a match Dim X As Integer 'counter X = 0 'set counter to 0 With ActiveSheet.Range("E36:E336") Set c = .Find(0, LookIn:=xlValues) If Not c Is Nothing Then FirstAddress = c.Address Do NextAddress = c.Address If NextAddress = FirstAddress + 1 Then ' are the matches continuous? X = X + 1 'increment the counter LastRow = NextAddress - 4 'save the row location Set c = .FindNext(c) End If Loop While Not c Is Nothing And X < 4 End If End With Range("E1:" & "O" & LastRow).Select Selection.PrintOut Copies:=1, Collate:=True End Sub Thanks -- Dave Peterson -- Dave Peterson |
#13
Posted to microsoft.public.excel.programming
|
|||
|
|||
Find same value in continuous Cells
So you're looking for whatever (non-blank looking stuff)?
Dim LastRow as long dim iRow as long Dim TopRow as Long Dim BottomRow as long with worksheets("whatever") lastRow = 0 Toprow = 36 bottomrow = .cells(.rows.count,"E").end(xlup).row for irow = bottomrow to toprow step -1 if trim(.cells(irow,"E").text) = "" then 'keep looking else lastrow = irow exit for end if next irow if lastrow = 0 then 'all 0's, what should happen else 'do the print end if end with And maybe you can use this line to know where to start: bottomrow = .cells(.rows.count,"E").end(xlup).row It's the same as selecting the last cell in column E (E65536 in xl2003) and then hitting the End key followed by the uparrow. It'll stop on the bottommost cell that has a formula or value. If you want to start at 370, you could change this line: bottomrow = .cells(.rows.count,"E").end(xlup).row to bottomrow = 370 But if you know you can start at 370, why are you filling formulas all the way to 3000???? Karen53 wrote: Hi Dave, Thanks! I'm getting closer. Yes, I would be checking for "". This works if I remove the If(isblank(whatever),"",Whatever. What would the code change be for that? Also, I have code out of the way at IG3000 at work. Instead of starting at the end of the worksheet, which would end up being about 3500, would I be able to start working up at about 370? Thank you so much Dave! "Dave Peterson" wrote: If you're really looking for 4 consecutive 0's, then try it. If you want to treat blanks (formulas that evaluate to ""), then the code would need to change. If 4 was just an arbitrary number that you figured would be enough to "guess" that you were at the end of the "real" data, I'd just loop from the bottom up looking for a non-zero value. Dim LastRow as long dim iRow as long Dim TopRow as Long Dim BottomRow as long with worksheets("whatever") lastRow = 0 Toprow = 36 bottomrow = .cells(.rows.count,"E").end(xlup).row for irow = bottomrow to toprow step -1 'I used text to avoid any empty cells if .cells(irow,"E").text = "0" then 'keep looking else lastrow = irow exit for end if next irow if lastrow = 0 then 'all 0's, what should happen else 'do the print end if end with Your original range was E36:E336. You'll be surprised at how fast your code loops through those rows--you won't notice a problem. (You may notice a severe delay if you start at row 1,000,000 (xl2007) or 65,536 (xl2003) and find the first row is close to row 36, though.) Karen53 wrote: Hi Dave, Thanks for your response. Yes, I am trying to find 4 consecutive cells containing the value 0. I haven't tried it yet but looking at what you wrote made me realize what has been happening. My cells contain alpha-numeric values all of which are loaded with 0. So what I'm really looking for is those cells which contain 0 alone, no extra characters. Unfortunately, I can't look for blank because the cells contain formulas and are not 'blank'. I need to find the end of the data from these formulas, many of which are not used all the time. Would you procedure below work in this situation? I feel doomed. Is there a way around this? Thank you for your help. "Dave Peterson" wrote: You meant to write that you're looking for 4 consecutive 0's, right? How about: Option Explicit Sub PrintDoc() Dim LastRow As Long Dim FirstAddress As String Dim FoundCell As Range Dim wks As Worksheet Dim WhatToFind As Variant 'string is ok here Set wks = ActiveSheet WhatToFind = 0 LastRow = 0 With wks 'check the bottom of column E??? 'With .Range("e36:e" & .Cells(.Rows.Count, "E").End(xlUp).Row) With .Range("E36:E336") Set FoundCell = .Find(What:=WhatToFind, _ after:=.Cells(.Cells.Count), _ LookIn:=xlFormulas, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If FoundCell Is Nothing Then MsgBox "no 0's in that range!" Exit Sub Else FirstAddress = FoundCell.Address Do If Application.CountIf(FoundCell.Resize(4, 1), _ WhatToFind) = 4 Then 'found it!! LastRow = FoundCell.Row Exit Do Else 'keep looking Set FoundCell = .FindNext(after:=FoundCell) If FoundCell.Address = FirstAddress Then 'back at the top, get out Exit Do End If End If Loop End If End With If LastRow = 0 Then MsgBox "No group of 4 0's found!" Else 'MsgBox .Range("E1:O" & LastRow).Address .Range("E1:O" & LastRow).PrintOut preview:=True 'nice for testing End If End With End Sub ps. .find is one of those VBA methods that shares its parameters with the user. If the user does Edit|Find and wants to search for 0 (xlpart rather than xlwhole), then your code may find lots of intermediate 0's and essentially waste time looking when it doesn't have to. It's always better to specify all those .find parms than to take a chance. (Especially with text (think matching case not what you expect) could cause a debugging nightmare.) Karen53 wrote: Hi, I need to find 4 cells in the same column that have the same value, 4. I need to save the row so I can use it as the end of my print range. Here is what I have so far but it's not working. Can anyone help? Sub PrintDoc() Dim LastRow As Integer 'Last Row of Printing Range Dim FirstAddress As Range 'First found occurance of a match Dim NextAddress As Range ' Next occurance of a match Dim X As Integer 'counter X = 0 'set counter to 0 With ActiveSheet.Range("E36:E336") Set c = .Find(0, LookIn:=xlValues) If Not c Is Nothing Then FirstAddress = c.Address Do NextAddress = c.Address If NextAddress = FirstAddress + 1 Then ' are the matches continuous? X = X + 1 'increment the counter LastRow = NextAddress - 4 'save the row location Set c = .FindNext(c) End If Loop While Not c Is Nothing And X < 4 End If End With Range("E1:" & "O" & LastRow).Select Selection.PrintOut Copies:=1, Collate:=True End Sub Thanks -- Dave Peterson -- Dave Peterson -- Dave Peterson |
#14
Posted to microsoft.public.excel.programming
|
|||
|
|||
Find same value in continuous Cells
YEAAAAAAAAAA! Thank you, Dave!
As to Row 3000, perhaps I have a misconception. I thought that if I have code anywhere at 3000, row 3000 becomes the end of the sheet. Do I have a mis-understanding? Thanks! "Dave Peterson" wrote: So you're looking for whatever (non-blank looking stuff)? Dim LastRow as long dim iRow as long Dim TopRow as Long Dim BottomRow as long with worksheets("whatever") lastRow = 0 Toprow = 36 bottomrow = .cells(.rows.count,"E").end(xlup).row for irow = bottomrow to toprow step -1 if trim(.cells(irow,"E").text) = "" then 'keep looking else lastrow = irow exit for end if next irow if lastrow = 0 then 'all 0's, what should happen else 'do the print end if end with And maybe you can use this line to know where to start: bottomrow = .cells(.rows.count,"E").end(xlup).row It's the same as selecting the last cell in column E (E65536 in xl2003) and then hitting the End key followed by the uparrow. It'll stop on the bottommost cell that has a formula or value. If you want to start at 370, you could change this line: bottomrow = .cells(.rows.count,"E").end(xlup).row to bottomrow = 370 But if you know you can start at 370, why are you filling formulas all the way to 3000???? Karen53 wrote: Hi Dave, Thanks! I'm getting closer. Yes, I would be checking for "". This works if I remove the If(isblank(whatever),"",Whatever. What would the code change be for that? Also, I have code out of the way at IG3000 at work. Instead of starting at the end of the worksheet, which would end up being about 3500, would I be able to start working up at about 370? Thank you so much Dave! "Dave Peterson" wrote: If you're really looking for 4 consecutive 0's, then try it. If you want to treat blanks (formulas that evaluate to ""), then the code would need to change. If 4 was just an arbitrary number that you figured would be enough to "guess" that you were at the end of the "real" data, I'd just loop from the bottom up looking for a non-zero value. Dim LastRow as long dim iRow as long Dim TopRow as Long Dim BottomRow as long with worksheets("whatever") lastRow = 0 Toprow = 36 bottomrow = .cells(.rows.count,"E").end(xlup).row for irow = bottomrow to toprow step -1 'I used text to avoid any empty cells if .cells(irow,"E").text = "0" then 'keep looking else lastrow = irow exit for end if next irow if lastrow = 0 then 'all 0's, what should happen else 'do the print end if end with Your original range was E36:E336. You'll be surprised at how fast your code loops through those rows--you won't notice a problem. (You may notice a severe delay if you start at row 1,000,000 (xl2007) or 65,536 (xl2003) and find the first row is close to row 36, though.) Karen53 wrote: Hi Dave, Thanks for your response. Yes, I am trying to find 4 consecutive cells containing the value 0. I haven't tried it yet but looking at what you wrote made me realize what has been happening. My cells contain alpha-numeric values all of which are loaded with 0. So what I'm really looking for is those cells which contain 0 alone, no extra characters. Unfortunately, I can't look for blank because the cells contain formulas and are not 'blank'. I need to find the end of the data from these formulas, many of which are not used all the time. Would you procedure below work in this situation? I feel doomed. Is there a way around this? Thank you for your help. "Dave Peterson" wrote: You meant to write that you're looking for 4 consecutive 0's, right? How about: Option Explicit Sub PrintDoc() Dim LastRow As Long Dim FirstAddress As String Dim FoundCell As Range Dim wks As Worksheet Dim WhatToFind As Variant 'string is ok here Set wks = ActiveSheet WhatToFind = 0 LastRow = 0 With wks 'check the bottom of column E??? 'With .Range("e36:e" & .Cells(.Rows.Count, "E").End(xlUp).Row) With .Range("E36:E336") Set FoundCell = .Find(What:=WhatToFind, _ after:=.Cells(.Cells.Count), _ LookIn:=xlFormulas, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If FoundCell Is Nothing Then MsgBox "no 0's in that range!" Exit Sub Else FirstAddress = FoundCell.Address Do If Application.CountIf(FoundCell.Resize(4, 1), _ WhatToFind) = 4 Then 'found it!! LastRow = FoundCell.Row Exit Do Else 'keep looking Set FoundCell = .FindNext(after:=FoundCell) If FoundCell.Address = FirstAddress Then 'back at the top, get out Exit Do End If End If Loop End If End With If LastRow = 0 Then MsgBox "No group of 4 0's found!" Else 'MsgBox .Range("E1:O" & LastRow).Address .Range("E1:O" & LastRow).PrintOut preview:=True 'nice for testing End If End With End Sub ps. .find is one of those VBA methods that shares its parameters with the user. If the user does Edit|Find and wants to search for 0 (xlpart rather than xlwhole), then your code may find lots of intermediate 0's and essentially waste time looking when it doesn't have to. It's always better to specify all those .find parms than to take a chance. (Especially with text (think matching case not what you expect) could cause a debugging nightmare.) Karen53 wrote: Hi, I need to find 4 cells in the same column that have the same value, 4. I need to save the row so I can use it as the end of my print range. Here is what I have so far but it's not working. Can anyone help? Sub PrintDoc() Dim LastRow As Integer 'Last Row of Printing Range Dim FirstAddress As Range 'First found occurance of a match Dim NextAddress As Range ' Next occurance of a match Dim X As Integer 'counter X = 0 'set counter to 0 With ActiveSheet.Range("E36:E336") Set c = .Find(0, LookIn:=xlValues) If Not c Is Nothing Then FirstAddress = c.Address Do NextAddress = c.Address If NextAddress = FirstAddress + 1 Then ' are the matches continuous? X = X + 1 'increment the counter LastRow = NextAddress - 4 'save the row location Set c = .FindNext(c) End If Loop While Not c Is Nothing And X < 4 End If End With Range("E1:" & "O" & LastRow).Select Selection.PrintOut Copies:=1, Collate:=True End Sub Thanks -- Dave Peterson -- Dave Peterson -- Dave Peterson |
#15
Posted to microsoft.public.excel.programming
|
|||
|
|||
Find same value in continuous Cells
If you have a formula in IG3000, then if you hit ctrl-end, excel will take you
at least to row 3000 (maybe further). But since we're looking at column E, we can limit our "bottom" row to the last cell in column E that has a formula or value. The ..cells(.rows.count,"E").end(xlup).row line may fly right past row 3000--if you didn't put anything in E300:E65536. If you do have a formula in E3000, then that line will stop there (well, if there's nothing below it in column E). with worksheets("somesheet") 'this finds what excel thinks is the last used row lastusedrow = .cells.specialcells(xlcelltypelastcell).row 'this finds the last used row in a column E lastusedrowinE = .cells(.rows.count,"E").end(xlup).row End with It really depends on what you want and how your data looks. ps. You may have noticed that if you put a value/formula in row 33333, then delete that value/formula, that excel still goes that far down when you hit ctrl-end. Debra Dalgleish does share some techniques for resetting the usedrange: http://contextures.com/xlfaqApp.html#Unused Karen53 wrote: YEAAAAAAAAAA! Thank you, Dave! As to Row 3000, perhaps I have a misconception. I thought that if I have code anywhere at 3000, row 3000 becomes the end of the sheet. Do I have a mis-understanding? Thanks! "Dave Peterson" wrote: So you're looking for whatever (non-blank looking stuff)? Dim LastRow as long dim iRow as long Dim TopRow as Long Dim BottomRow as long with worksheets("whatever") lastRow = 0 Toprow = 36 bottomrow = .cells(.rows.count,"E").end(xlup).row for irow = bottomrow to toprow step -1 if trim(.cells(irow,"E").text) = "" then 'keep looking else lastrow = irow exit for end if next irow if lastrow = 0 then 'all 0's, what should happen else 'do the print end if end with And maybe you can use this line to know where to start: bottomrow = .cells(.rows.count,"E").end(xlup).row It's the same as selecting the last cell in column E (E65536 in xl2003) and then hitting the End key followed by the uparrow. It'll stop on the bottommost cell that has a formula or value. If you want to start at 370, you could change this line: bottomrow = .cells(.rows.count,"E").end(xlup).row to bottomrow = 370 But if you know you can start at 370, why are you filling formulas all the way to 3000???? Karen53 wrote: Hi Dave, Thanks! I'm getting closer. Yes, I would be checking for "". This works if I remove the If(isblank(whatever),"",Whatever. What would the code change be for that? Also, I have code out of the way at IG3000 at work. Instead of starting at the end of the worksheet, which would end up being about 3500, would I be able to start working up at about 370? Thank you so much Dave! "Dave Peterson" wrote: If you're really looking for 4 consecutive 0's, then try it. If you want to treat blanks (formulas that evaluate to ""), then the code would need to change. If 4 was just an arbitrary number that you figured would be enough to "guess" that you were at the end of the "real" data, I'd just loop from the bottom up looking for a non-zero value. Dim LastRow as long dim iRow as long Dim TopRow as Long Dim BottomRow as long with worksheets("whatever") lastRow = 0 Toprow = 36 bottomrow = .cells(.rows.count,"E").end(xlup).row for irow = bottomrow to toprow step -1 'I used text to avoid any empty cells if .cells(irow,"E").text = "0" then 'keep looking else lastrow = irow exit for end if next irow if lastrow = 0 then 'all 0's, what should happen else 'do the print end if end with Your original range was E36:E336. You'll be surprised at how fast your code loops through those rows--you won't notice a problem. (You may notice a severe delay if you start at row 1,000,000 (xl2007) or 65,536 (xl2003) and find the first row is close to row 36, though.) Karen53 wrote: Hi Dave, Thanks for your response. Yes, I am trying to find 4 consecutive cells containing the value 0. I haven't tried it yet but looking at what you wrote made me realize what has been happening. My cells contain alpha-numeric values all of which are loaded with 0. So what I'm really looking for is those cells which contain 0 alone, no extra characters. Unfortunately, I can't look for blank because the cells contain formulas and are not 'blank'. I need to find the end of the data from these formulas, many of which are not used all the time. Would you procedure below work in this situation? I feel doomed. Is there a way around this? Thank you for your help. "Dave Peterson" wrote: You meant to write that you're looking for 4 consecutive 0's, right? How about: Option Explicit Sub PrintDoc() Dim LastRow As Long Dim FirstAddress As String Dim FoundCell As Range Dim wks As Worksheet Dim WhatToFind As Variant 'string is ok here Set wks = ActiveSheet WhatToFind = 0 LastRow = 0 With wks 'check the bottom of column E??? 'With .Range("e36:e" & .Cells(.Rows.Count, "E").End(xlUp).Row) With .Range("E36:E336") Set FoundCell = .Find(What:=WhatToFind, _ after:=.Cells(.Cells.Count), _ LookIn:=xlFormulas, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If FoundCell Is Nothing Then MsgBox "no 0's in that range!" Exit Sub Else FirstAddress = FoundCell.Address Do If Application.CountIf(FoundCell.Resize(4, 1), _ WhatToFind) = 4 Then 'found it!! LastRow = FoundCell.Row Exit Do Else 'keep looking Set FoundCell = .FindNext(after:=FoundCell) If FoundCell.Address = FirstAddress Then 'back at the top, get out Exit Do End If End If Loop End If End With If LastRow = 0 Then MsgBox "No group of 4 0's found!" Else 'MsgBox .Range("E1:O" & LastRow).Address .Range("E1:O" & LastRow).PrintOut preview:=True 'nice for testing End If End With End Sub ps. .find is one of those VBA methods that shares its parameters with the user. If the user does Edit|Find and wants to search for 0 (xlpart rather than xlwhole), then your code may find lots of intermediate 0's and essentially waste time looking when it doesn't have to. It's always better to specify all those .find parms than to take a chance. (Especially with text (think matching case not what you expect) could cause a debugging nightmare.) Karen53 wrote: Hi, I need to find 4 cells in the same column that have the same value, 4. I need to save the row so I can use it as the end of my print range. Here is what I have so far but it's not working. Can anyone help? Sub PrintDoc() Dim LastRow As Integer 'Last Row of Printing Range Dim FirstAddress As Range 'First found occurance of a match Dim NextAddress As Range ' Next occurance of a match Dim X As Integer 'counter X = 0 'set counter to 0 With ActiveSheet.Range("E36:E336") Set c = .Find(0, LookIn:=xlValues) If Not c Is Nothing Then FirstAddress = c.Address Do NextAddress = c.Address If NextAddress = FirstAddress + 1 Then ' are the matches continuous? X = X + 1 'increment the counter LastRow = NextAddress - 4 'save the row location Set c = .FindNext(c) End If Loop While Not c Is Nothing And X < 4 End If End With Range("E1:" & "O" & LastRow).Select Selection.PrintOut Copies:=1, Collate:=True End Sub Thanks -- Dave Peterson -- Dave Peterson -- Dave Peterson -- Dave Peterson |
#16
Posted to microsoft.public.excel.programming
|
|||
|
|||
Find same value in continuous Cells
Thanks, Dave! You have given me so much useful information.
Are there any books you would recommend to help me gat a handle on VBA for Excel? I see there are many books and some better than others. Often my problem is I don't know what something is called in order to look it up. "Dave Peterson" wrote: If you have a formula in IG3000, then if you hit ctrl-end, excel will take you at least to row 3000 (maybe further). But since we're looking at column E, we can limit our "bottom" row to the last cell in column E that has a formula or value. The ..cells(.rows.count,"E").end(xlup).row line may fly right past row 3000--if you didn't put anything in E300:E65536. If you do have a formula in E3000, then that line will stop there (well, if there's nothing below it in column E). with worksheets("somesheet") 'this finds what excel thinks is the last used row lastusedrow = .cells.specialcells(xlcelltypelastcell).row 'this finds the last used row in a column E lastusedrowinE = .cells(.rows.count,"E").end(xlup).row End with It really depends on what you want and how your data looks. ps. You may have noticed that if you put a value/formula in row 33333, then delete that value/formula, that excel still goes that far down when you hit ctrl-end. Debra Dalgleish does share some techniques for resetting the usedrange: http://contextures.com/xlfaqApp.html#Unused Karen53 wrote: YEAAAAAAAAAA! Thank you, Dave! As to Row 3000, perhaps I have a misconception. I thought that if I have code anywhere at 3000, row 3000 becomes the end of the sheet. Do I have a mis-understanding? Thanks! "Dave Peterson" wrote: So you're looking for whatever (non-blank looking stuff)? Dim LastRow as long dim iRow as long Dim TopRow as Long Dim BottomRow as long with worksheets("whatever") lastRow = 0 Toprow = 36 bottomrow = .cells(.rows.count,"E").end(xlup).row for irow = bottomrow to toprow step -1 if trim(.cells(irow,"E").text) = "" then 'keep looking else lastrow = irow exit for end if next irow if lastrow = 0 then 'all 0's, what should happen else 'do the print end if end with And maybe you can use this line to know where to start: bottomrow = .cells(.rows.count,"E").end(xlup).row It's the same as selecting the last cell in column E (E65536 in xl2003) and then hitting the End key followed by the uparrow. It'll stop on the bottommost cell that has a formula or value. If you want to start at 370, you could change this line: bottomrow = .cells(.rows.count,"E").end(xlup).row to bottomrow = 370 But if you know you can start at 370, why are you filling formulas all the way to 3000???? Karen53 wrote: Hi Dave, Thanks! I'm getting closer. Yes, I would be checking for "". This works if I remove the If(isblank(whatever),"",Whatever. What would the code change be for that? Also, I have code out of the way at IG3000 at work. Instead of starting at the end of the worksheet, which would end up being about 3500, would I be able to start working up at about 370? Thank you so much Dave! "Dave Peterson" wrote: If you're really looking for 4 consecutive 0's, then try it. If you want to treat blanks (formulas that evaluate to ""), then the code would need to change. If 4 was just an arbitrary number that you figured would be enough to "guess" that you were at the end of the "real" data, I'd just loop from the bottom up looking for a non-zero value. Dim LastRow as long dim iRow as long Dim TopRow as Long Dim BottomRow as long with worksheets("whatever") lastRow = 0 Toprow = 36 bottomrow = .cells(.rows.count,"E").end(xlup).row for irow = bottomrow to toprow step -1 'I used text to avoid any empty cells if .cells(irow,"E").text = "0" then 'keep looking else lastrow = irow exit for end if next irow if lastrow = 0 then 'all 0's, what should happen else 'do the print end if end with Your original range was E36:E336. You'll be surprised at how fast your code loops through those rows--you won't notice a problem. (You may notice a severe delay if you start at row 1,000,000 (xl2007) or 65,536 (xl2003) and find the first row is close to row 36, though.) Karen53 wrote: Hi Dave, Thanks for your response. Yes, I am trying to find 4 consecutive cells containing the value 0. I haven't tried it yet but looking at what you wrote made me realize what has been happening. My cells contain alpha-numeric values all of which are loaded with 0. So what I'm really looking for is those cells which contain 0 alone, no extra characters. Unfortunately, I can't look for blank because the cells contain formulas and are not 'blank'. I need to find the end of the data from these formulas, many of which are not used all the time. Would you procedure below work in this situation? I feel doomed. Is there a way around this? Thank you for your help. "Dave Peterson" wrote: You meant to write that you're looking for 4 consecutive 0's, right? How about: Option Explicit Sub PrintDoc() Dim LastRow As Long Dim FirstAddress As String Dim FoundCell As Range Dim wks As Worksheet Dim WhatToFind As Variant 'string is ok here Set wks = ActiveSheet WhatToFind = 0 LastRow = 0 With wks 'check the bottom of column E??? 'With .Range("e36:e" & .Cells(.Rows.Count, "E").End(xlUp).Row) With .Range("E36:E336") Set FoundCell = .Find(What:=WhatToFind, _ after:=.Cells(.Cells.Count), _ LookIn:=xlFormulas, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If FoundCell Is Nothing Then MsgBox "no 0's in that range!" Exit Sub Else FirstAddress = FoundCell.Address Do If Application.CountIf(FoundCell.Resize(4, 1), _ WhatToFind) = 4 Then 'found it!! LastRow = FoundCell.Row Exit Do Else 'keep looking Set FoundCell = .FindNext(after:=FoundCell) If FoundCell.Address = FirstAddress Then 'back at the top, get out Exit Do End If End If Loop End If End With If LastRow = 0 Then MsgBox "No group of 4 0's found!" Else 'MsgBox .Range("E1:O" & LastRow).Address .Range("E1:O" & LastRow).PrintOut preview:=True 'nice for testing End If End With End Sub ps. .find is one of those VBA methods that shares its parameters with the user. If the user does Edit|Find and wants to search for 0 (xlpart rather than xlwhole), then your code may find lots of intermediate 0's and essentially waste time looking when it doesn't have to. It's always better to specify all those .find parms than to take a chance. (Especially with text (think matching case not what you expect) could cause a debugging nightmare.) Karen53 wrote: Hi, I need to find 4 cells in the same column that have the same value, 4. I need to save the row so I can use it as the end of my print range. Here is what I have so far but it's not working. Can anyone help? Sub PrintDoc() Dim LastRow As Integer 'Last Row of Printing Range Dim FirstAddress As Range 'First found occurance of a match Dim NextAddress As Range ' Next occurance of a match Dim X As Integer 'counter X = 0 'set counter to 0 With ActiveSheet.Range("E36:E336") Set c = .Find(0, LookIn:=xlValues) If Not c Is Nothing Then FirstAddress = c.Address Do NextAddress = c.Address If NextAddress = FirstAddress + 1 Then ' are the matches continuous? X = X + 1 'increment the counter LastRow = NextAddress - 4 'save the row location Set c = .FindNext(c) End If Loop While Not c Is Nothing And X < 4 End If End With Range("E1:" & "O" & LastRow).Select Selection.PrintOut Copies:=1, Collate:=True End Sub Thanks -- Dave Peterson -- Dave Peterson -- Dave Peterson -- |
#17
Posted to microsoft.public.excel.programming
|
|||
|
|||
Find same value in continuous Cells
I don't think you can go wrong by starting with John Walkenbach's books.
Debra Dalgleish has a list of books at her site: http://www.contextures.com/xlbooks.html See if you can find them in your local bookstore/internet site and you can choose what one you like best. Karen53 wrote: Thanks, Dave! You have given me so much useful information. Are there any books you would recommend to help me gat a handle on VBA for Excel? I see there are many books and some better than others. Often my problem is I don't know what something is called in order to look it up. "Dave Peterson" wrote: If you have a formula in IG3000, then if you hit ctrl-end, excel will take you at least to row 3000 (maybe further). But since we're looking at column E, we can limit our "bottom" row to the last cell in column E that has a formula or value. The ..cells(.rows.count,"E").end(xlup).row line may fly right past row 3000--if you didn't put anything in E300:E65536. If you do have a formula in E3000, then that line will stop there (well, if there's nothing below it in column E). with worksheets("somesheet") 'this finds what excel thinks is the last used row lastusedrow = .cells.specialcells(xlcelltypelastcell).row 'this finds the last used row in a column E lastusedrowinE = .cells(.rows.count,"E").end(xlup).row End with It really depends on what you want and how your data looks. ps. You may have noticed that if you put a value/formula in row 33333, then delete that value/formula, that excel still goes that far down when you hit ctrl-end. Debra Dalgleish does share some techniques for resetting the usedrange: http://contextures.com/xlfaqApp.html#Unused Karen53 wrote: YEAAAAAAAAAA! Thank you, Dave! As to Row 3000, perhaps I have a misconception. I thought that if I have code anywhere at 3000, row 3000 becomes the end of the sheet. Do I have a mis-understanding? Thanks! "Dave Peterson" wrote: So you're looking for whatever (non-blank looking stuff)? Dim LastRow as long dim iRow as long Dim TopRow as Long Dim BottomRow as long with worksheets("whatever") lastRow = 0 Toprow = 36 bottomrow = .cells(.rows.count,"E").end(xlup).row for irow = bottomrow to toprow step -1 if trim(.cells(irow,"E").text) = "" then 'keep looking else lastrow = irow exit for end if next irow if lastrow = 0 then 'all 0's, what should happen else 'do the print end if end with And maybe you can use this line to know where to start: bottomrow = .cells(.rows.count,"E").end(xlup).row It's the same as selecting the last cell in column E (E65536 in xl2003) and then hitting the End key followed by the uparrow. It'll stop on the bottommost cell that has a formula or value. If you want to start at 370, you could change this line: bottomrow = .cells(.rows.count,"E").end(xlup).row to bottomrow = 370 But if you know you can start at 370, why are you filling formulas all the way to 3000???? Karen53 wrote: Hi Dave, Thanks! I'm getting closer. Yes, I would be checking for "". This works if I remove the If(isblank(whatever),"",Whatever. What would the code change be for that? Also, I have code out of the way at IG3000 at work. Instead of starting at the end of the worksheet, which would end up being about 3500, would I be able to start working up at about 370? Thank you so much Dave! "Dave Peterson" wrote: If you're really looking for 4 consecutive 0's, then try it. If you want to treat blanks (formulas that evaluate to ""), then the code would need to change. If 4 was just an arbitrary number that you figured would be enough to "guess" that you were at the end of the "real" data, I'd just loop from the bottom up looking for a non-zero value. Dim LastRow as long dim iRow as long Dim TopRow as Long Dim BottomRow as long with worksheets("whatever") lastRow = 0 Toprow = 36 bottomrow = .cells(.rows.count,"E").end(xlup).row for irow = bottomrow to toprow step -1 'I used text to avoid any empty cells if .cells(irow,"E").text = "0" then 'keep looking else lastrow = irow exit for end if next irow if lastrow = 0 then 'all 0's, what should happen else 'do the print end if end with Your original range was E36:E336. You'll be surprised at how fast your code loops through those rows--you won't notice a problem. (You may notice a severe delay if you start at row 1,000,000 (xl2007) or 65,536 (xl2003) and find the first row is close to row 36, though.) Karen53 wrote: Hi Dave, Thanks for your response. Yes, I am trying to find 4 consecutive cells containing the value 0. I haven't tried it yet but looking at what you wrote made me realize what has been happening. My cells contain alpha-numeric values all of which are loaded with 0. So what I'm really looking for is those cells which contain 0 alone, no extra characters. Unfortunately, I can't look for blank because the cells contain formulas and are not 'blank'. I need to find the end of the data from these formulas, many of which are not used all the time. Would you procedure below work in this situation? I feel doomed. Is there a way around this? Thank you for your help. "Dave Peterson" wrote: You meant to write that you're looking for 4 consecutive 0's, right? How about: Option Explicit Sub PrintDoc() Dim LastRow As Long Dim FirstAddress As String Dim FoundCell As Range Dim wks As Worksheet Dim WhatToFind As Variant 'string is ok here Set wks = ActiveSheet WhatToFind = 0 LastRow = 0 With wks 'check the bottom of column E??? 'With .Range("e36:e" & .Cells(.Rows.Count, "E").End(xlUp).Row) With .Range("E36:E336") Set FoundCell = .Find(What:=WhatToFind, _ after:=.Cells(.Cells.Count), _ LookIn:=xlFormulas, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If FoundCell Is Nothing Then MsgBox "no 0's in that range!" Exit Sub Else FirstAddress = FoundCell.Address Do If Application.CountIf(FoundCell.Resize(4, 1), _ WhatToFind) = 4 Then 'found it!! LastRow = FoundCell.Row Exit Do Else 'keep looking Set FoundCell = .FindNext(after:=FoundCell) If FoundCell.Address = FirstAddress Then 'back at the top, get out Exit Do End If End If Loop End If End With If LastRow = 0 Then MsgBox "No group of 4 0's found!" Else 'MsgBox .Range("E1:O" & LastRow).Address .Range("E1:O" & LastRow).PrintOut preview:=True 'nice for testing End If End With End Sub ps. .find is one of those VBA methods that shares its parameters with the user. If the user does Edit|Find and wants to search for 0 (xlpart rather than xlwhole), then your code may find lots of intermediate 0's and essentially waste time looking when it doesn't have to. It's always better to specify all those .find parms than to take a chance. (Especially with text (think matching case not what you expect) could cause a debugging nightmare.) Karen53 wrote: Hi, I need to find 4 cells in the same column that have the same value, 4. I need to save the row so I can use it as the end of my print range. Here is what I have so far but it's not working. Can anyone help? Sub PrintDoc() Dim LastRow As Integer 'Last Row of Printing Range Dim FirstAddress As Range 'First found occurance of a match Dim NextAddress As Range ' Next occurance of a match Dim X As Integer 'counter X = 0 'set counter to 0 With ActiveSheet.Range("E36:E336") Set c = .Find(0, LookIn:=xlValues) If Not c Is Nothing Then FirstAddress = c.Address Do NextAddress = c.Address If NextAddress = FirstAddress + 1 Then ' are the matches continuous? X = X + 1 'increment the counter LastRow = NextAddress - 4 'save the row location Set c = .FindNext(c) End If Loop While Not c Is Nothing And X < 4 End If End With Range("E1:" & "O" & LastRow).Select Selection.PrintOut Copies:=1, Collate:=True End Sub Thanks -- Dave Peterson -- Dave Peterson -- Dave Peterson -- -- Dave Peterson |
#18
Posted to microsoft.public.excel.programming
|
|||
|
|||
Find same value in continuous Cells
Thanks!
"Dave Peterson" wrote: I don't think you can go wrong by starting with John Walkenbach's books. Debra Dalgleish has a list of books at her site: http://www.contextures.com/xlbooks.html See if you can find them in your local bookstore/internet site and you can choose what one you like best. Karen53 wrote: Thanks, Dave! You have given me so much useful information. Are there any books you would recommend to help me gat a handle on VBA for Excel? I see there are many books and some better than others. Often my problem is I don't know what something is called in order to look it up. "Dave Peterson" wrote: If you have a formula in IG3000, then if you hit ctrl-end, excel will take you at least to row 3000 (maybe further). But since we're looking at column E, we can limit our "bottom" row to the last cell in column E that has a formula or value. The ..cells(.rows.count,"E").end(xlup).row line may fly right past row 3000--if you didn't put anything in E300:E65536. If you do have a formula in E3000, then that line will stop there (well, if there's nothing below it in column E). with worksheets("somesheet") 'this finds what excel thinks is the last used row lastusedrow = .cells.specialcells(xlcelltypelastcell).row 'this finds the last used row in a column E lastusedrowinE = .cells(.rows.count,"E").end(xlup).row End with It really depends on what you want and how your data looks. ps. You may have noticed that if you put a value/formula in row 33333, then delete that value/formula, that excel still goes that far down when you hit ctrl-end. Debra Dalgleish does share some techniques for resetting the usedrange: http://contextures.com/xlfaqApp.html#Unused Karen53 wrote: YEAAAAAAAAAA! Thank you, Dave! As to Row 3000, perhaps I have a misconception. I thought that if I have code anywhere at 3000, row 3000 becomes the end of the sheet. Do I have a mis-understanding? Thanks! "Dave Peterson" wrote: So you're looking for whatever (non-blank looking stuff)? Dim LastRow as long dim iRow as long Dim TopRow as Long Dim BottomRow as long with worksheets("whatever") lastRow = 0 Toprow = 36 bottomrow = .cells(.rows.count,"E").end(xlup).row for irow = bottomrow to toprow step -1 if trim(.cells(irow,"E").text) = "" then 'keep looking else lastrow = irow exit for end if next irow if lastrow = 0 then 'all 0's, what should happen else 'do the print end if end with And maybe you can use this line to know where to start: bottomrow = .cells(.rows.count,"E").end(xlup).row It's the same as selecting the last cell in column E (E65536 in xl2003) and then hitting the End key followed by the uparrow. It'll stop on the bottommost cell that has a formula or value. If you want to start at 370, you could change this line: bottomrow = .cells(.rows.count,"E").end(xlup).row to bottomrow = 370 But if you know you can start at 370, why are you filling formulas all the way to 3000???? Karen53 wrote: Hi Dave, Thanks! I'm getting closer. Yes, I would be checking for "". This works if I remove the If(isblank(whatever),"",Whatever. What would the code change be for that? Also, I have code out of the way at IG3000 at work. Instead of starting at the end of the worksheet, which would end up being about 3500, would I be able to start working up at about 370? Thank you so much Dave! "Dave Peterson" wrote: If you're really looking for 4 consecutive 0's, then try it. If you want to treat blanks (formulas that evaluate to ""), then the code would need to change. If 4 was just an arbitrary number that you figured would be enough to "guess" that you were at the end of the "real" data, I'd just loop from the bottom up looking for a non-zero value. Dim LastRow as long dim iRow as long Dim TopRow as Long Dim BottomRow as long with worksheets("whatever") lastRow = 0 Toprow = 36 bottomrow = .cells(.rows.count,"E").end(xlup).row for irow = bottomrow to toprow step -1 'I used text to avoid any empty cells if .cells(irow,"E").text = "0" then 'keep looking else lastrow = irow exit for end if next irow if lastrow = 0 then 'all 0's, what should happen else 'do the print end if end with Your original range was E36:E336. You'll be surprised at how fast your code loops through those rows--you won't notice a problem. (You may notice a severe delay if you start at row 1,000,000 (xl2007) or 65,536 (xl2003) and find the first row is close to row 36, though.) Karen53 wrote: Hi Dave, Thanks for your response. Yes, I am trying to find 4 consecutive cells containing the value 0. I haven't tried it yet but looking at what you wrote made me realize what has been happening. My cells contain alpha-numeric values all of which are loaded with 0. So what I'm really looking for is those cells which contain 0 alone, no extra characters. Unfortunately, I can't look for blank because the cells contain formulas and are not 'blank'. I need to find the end of the data from these formulas, many of which are not used all the time. Would you procedure below work in this situation? I feel doomed. Is there a way around this? Thank you for your help. "Dave Peterson" wrote: You meant to write that you're looking for 4 consecutive 0's, right? How about: Option Explicit Sub PrintDoc() Dim LastRow As Long Dim FirstAddress As String Dim FoundCell As Range Dim wks As Worksheet Dim WhatToFind As Variant 'string is ok here Set wks = ActiveSheet WhatToFind = 0 LastRow = 0 With wks 'check the bottom of column E??? 'With .Range("e36:e" & .Cells(.Rows.Count, "E").End(xlUp).Row) With .Range("E36:E336") Set FoundCell = .Find(What:=WhatToFind, _ after:=.Cells(.Cells.Count), _ LookIn:=xlFormulas, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If FoundCell Is Nothing Then MsgBox "no 0's in that range!" Exit Sub Else FirstAddress = FoundCell.Address Do If Application.CountIf(FoundCell.Resize(4, 1), _ WhatToFind) = 4 Then 'found it!! LastRow = FoundCell.Row Exit Do Else 'keep looking Set FoundCell = .FindNext(after:=FoundCell) If FoundCell.Address = FirstAddress Then 'back at the top, get out Exit Do End If End If Loop End If End With If LastRow = 0 Then MsgBox "No group of 4 0's found!" Else 'MsgBox .Range("E1:O" & LastRow).Address .Range("E1:O" & LastRow).PrintOut preview:=True 'nice for testing End If End With End Sub ps. .find is one of those VBA methods that shares its parameters with the user. If the user does Edit|Find and wants to search for 0 (xlpart rather than xlwhole), then your code may find lots of intermediate 0's and essentially waste time looking when it doesn't have to. It's always better to specify all those .find parms than to take a chance. (Especially with text (think matching case not what you expect) could cause a debugging nightmare.) Karen53 wrote: Hi, I need to find 4 cells in the same column that have the same value, 4. I need to save the row so I can use it as the end of my print range. Here is what I have so far but it's not working. Can anyone help? Sub PrintDoc() Dim LastRow As Integer 'Last Row of Printing Range Dim FirstAddress As Range 'First found occurance of a match Dim NextAddress As Range ' Next occurance of a match Dim X As Integer 'counter X = 0 'set counter to 0 With ActiveSheet.Range("E36:E336") Set c = .Find(0, LookIn:=xlValues) If Not c Is Nothing Then FirstAddress = c.Address Do NextAddress = c.Address If NextAddress = FirstAddress + 1 Then ' are the matches continuous? X = X + 1 'increment the counter LastRow = NextAddress - 4 'save the row location Set c = .FindNext(c) End If Loop While Not c Is Nothing And X < 4 End If End With Range("E1:" & "O" & LastRow).Select Selection.PrintOut Copies:=1, Collate:=True |
#19
Posted to microsoft.public.excel.programming
|
|||
|
|||
Find same value in continuous Cells
You're welcome.
Karen53 wrote: Thanks! "Dave Peterson" wrote: I don't think you can go wrong by starting with John Walkenbach's books. Debra Dalgleish has a list of books at her site: http://www.contextures.com/xlbooks.html See if you can find them in your local bookstore/internet site and you can choose what one you like best. Karen53 wrote: Thanks, Dave! You have given me so much useful information. Are there any books you would recommend to help me gat a handle on VBA for Excel? I see there are many books and some better than others. Often my problem is I don't know what something is called in order to look it up. "Dave Peterson" wrote: If you have a formula in IG3000, then if you hit ctrl-end, excel will take you at least to row 3000 (maybe further). But since we're looking at column E, we can limit our "bottom" row to the last cell in column E that has a formula or value. The ..cells(.rows.count,"E").end(xlup).row line may fly right past row 3000--if you didn't put anything in E300:E65536. If you do have a formula in E3000, then that line will stop there (well, if there's nothing below it in column E). with worksheets("somesheet") 'this finds what excel thinks is the last used row lastusedrow = .cells.specialcells(xlcelltypelastcell).row 'this finds the last used row in a column E lastusedrowinE = .cells(.rows.count,"E").end(xlup).row End with It really depends on what you want and how your data looks. ps. You may have noticed that if you put a value/formula in row 33333, then delete that value/formula, that excel still goes that far down when you hit ctrl-end. Debra Dalgleish does share some techniques for resetting the usedrange: http://contextures.com/xlfaqApp.html#Unused Karen53 wrote: YEAAAAAAAAAA! Thank you, Dave! As to Row 3000, perhaps I have a misconception. I thought that if I have code anywhere at 3000, row 3000 becomes the end of the sheet. Do I have a mis-understanding? Thanks! "Dave Peterson" wrote: So you're looking for whatever (non-blank looking stuff)? Dim LastRow as long dim iRow as long Dim TopRow as Long Dim BottomRow as long with worksheets("whatever") lastRow = 0 Toprow = 36 bottomrow = .cells(.rows.count,"E").end(xlup).row for irow = bottomrow to toprow step -1 if trim(.cells(irow,"E").text) = "" then 'keep looking else lastrow = irow exit for end if next irow if lastrow = 0 then 'all 0's, what should happen else 'do the print end if end with And maybe you can use this line to know where to start: bottomrow = .cells(.rows.count,"E").end(xlup).row It's the same as selecting the last cell in column E (E65536 in xl2003) and then hitting the End key followed by the uparrow. It'll stop on the bottommost cell that has a formula or value. If you want to start at 370, you could change this line: bottomrow = .cells(.rows.count,"E").end(xlup).row to bottomrow = 370 But if you know you can start at 370, why are you filling formulas all the way to 3000???? Karen53 wrote: Hi Dave, Thanks! I'm getting closer. Yes, I would be checking for "". This works if I remove the If(isblank(whatever),"",Whatever. What would the code change be for that? Also, I have code out of the way at IG3000 at work. Instead of starting at the end of the worksheet, which would end up being about 3500, would I be able to start working up at about 370? Thank you so much Dave! "Dave Peterson" wrote: If you're really looking for 4 consecutive 0's, then try it. If you want to treat blanks (formulas that evaluate to ""), then the code would need to change. If 4 was just an arbitrary number that you figured would be enough to "guess" that you were at the end of the "real" data, I'd just loop from the bottom up looking for a non-zero value. Dim LastRow as long dim iRow as long Dim TopRow as Long Dim BottomRow as long with worksheets("whatever") lastRow = 0 Toprow = 36 bottomrow = .cells(.rows.count,"E").end(xlup).row for irow = bottomrow to toprow step -1 'I used text to avoid any empty cells if .cells(irow,"E").text = "0" then 'keep looking else lastrow = irow exit for end if next irow if lastrow = 0 then 'all 0's, what should happen else 'do the print end if end with Your original range was E36:E336. You'll be surprised at how fast your code loops through those rows--you won't notice a problem. (You may notice a severe delay if you start at row 1,000,000 (xl2007) or 65,536 (xl2003) and find the first row is close to row 36, though.) Karen53 wrote: Hi Dave, Thanks for your response. Yes, I am trying to find 4 consecutive cells containing the value 0. I haven't tried it yet but looking at what you wrote made me realize what has been happening. My cells contain alpha-numeric values all of which are loaded with 0. So what I'm really looking for is those cells which contain 0 alone, no extra characters. Unfortunately, I can't look for blank because the cells contain formulas and are not 'blank'. I need to find the end of the data from these formulas, many of which are not used all the time. Would you procedure below work in this situation? I feel doomed. Is there a way around this? Thank you for your help. "Dave Peterson" wrote: You meant to write that you're looking for 4 consecutive 0's, right? How about: Option Explicit Sub PrintDoc() Dim LastRow As Long Dim FirstAddress As String Dim FoundCell As Range Dim wks As Worksheet Dim WhatToFind As Variant 'string is ok here Set wks = ActiveSheet WhatToFind = 0 LastRow = 0 With wks 'check the bottom of column E??? 'With .Range("e36:e" & .Cells(.Rows.Count, "E").End(xlUp).Row) With .Range("E36:E336") Set FoundCell = .Find(What:=WhatToFind, _ after:=.Cells(.Cells.Count), _ LookIn:=xlFormulas, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If FoundCell Is Nothing Then MsgBox "no 0's in that range!" Exit Sub Else FirstAddress = FoundCell.Address Do If Application.CountIf(FoundCell.Resize(4, 1), _ WhatToFind) = 4 Then 'found it!! LastRow = FoundCell.Row Exit Do Else 'keep looking Set FoundCell = .FindNext(after:=FoundCell) If FoundCell.Address = FirstAddress Then 'back at the top, get out Exit Do End If End If Loop End If End With If LastRow = 0 Then MsgBox "No group of 4 0's found!" Else 'MsgBox .Range("E1:O" & LastRow).Address .Range("E1:O" & LastRow).PrintOut preview:=True 'nice for testing End If End With End Sub ps. .find is one of those VBA methods that shares its parameters with the user. If the user does Edit|Find and wants to search for 0 (xlpart rather than xlwhole), then your code may find lots of intermediate 0's and essentially waste time looking when it doesn't have to. It's always better to specify all those .find parms than to take a chance. (Especially with text (think matching case not what you expect) could cause a debugging nightmare.) Karen53 wrote: Hi, I need to find 4 cells in the same column that have the same value, 4. I need to save the row so I can use it as the end of my print range. Here is what I have so far but it's not working. Can anyone help? Sub PrintDoc() Dim LastRow As Integer 'Last Row of Printing Range Dim FirstAddress As Range 'First found occurance of a match Dim NextAddress As Range ' Next occurance of a match Dim X As Integer 'counter X = 0 'set counter to 0 With ActiveSheet.Range("E36:E336") Set c = .Find(0, LookIn:=xlValues) If Not c Is Nothing Then FirstAddress = c.Address Do NextAddress = c.Address If NextAddress = FirstAddress + 1 Then ' are the matches continuous? X = X + 1 'increment the counter LastRow = NextAddress - 4 'save the row location Set c = .FindNext(c) End If Loop While Not c Is Nothing And X < 4 End If End With Range("E1:" & "O" & LastRow).Select Selection.PrintOut Copies:=1, Collate:=True -- Dave Peterson |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
A GROUP OF CONTINUOUS CELLS ARE KNOWN AS | Excel Discussion (Misc queries) | |||
Count Continuous data between cells | Excel Worksheet Functions | |||
Continuous hughlighting of cells | Excel Discussion (Misc queries) | |||
COUNTIF With Non-Continuous Cells | Excel Worksheet Functions | |||
Updating Sheets on a non continuous cells | Excel Programming |