VB: test Count how many consecutive rows-cells in column X have a dot "." from the active cell down RRS feed

  • Question

  • pardon, original title was not accurate (changing),  i am working on this & have more accurate-brief in post: 181007 below.  i will post back what i come up with & may not need a reply just yet unless you see a fix for 1 liner eg in that post.  old title:

    VB: Need line for test activecell.row, column A, Left, 1).text = "." (but for A to extend down x number of rows)


    hi,  i am looking for what may be a 1 liner (or there abouts) to test if column A is a work row.  they all have  a left character, 1) = "."

    i can do that for one line, but spent some time trying to get to work for extending down 5 rows from the current row.  eg have:

        'If Left(Cells(activecell.row, "A:A").Text, 1) = "." Then    'yes

    pardon, i can do some medium size things, but take hits on a lot of small syntax items.  i can list some of the variations i tried below (more to laugh at i guess).  if roughly:

        'If Left(Cells(RANGE(activecell.row).RESIZE(5,0), "A:A").Text, 1) = "." Then    'ALL 5 rows left 1 = "." from selected row down for column: A

    thanks in advance.  the purpose will be for exit a click event at a spec point, if the next 5 rows are work rows.



    ==========    NOTES:  (just the left overs,  trying too many variations;  need to use activecell.row instead of activewindow;  part of a click event)




    If 1 Then

        If RANGE("a1:a2").Value = "." Then
        'If Left(Cells(RANGE(activecell.row).RESIZE(5, 0), "A:A").Text, 1) = "." Then  'no
        'If Left(Cells(RANGE(activecell.row).RESIZE(5, 0), "A:A").Text, 1) = "." Then  'no
        'If Left(Cells(activecell.row, "A:A").Text, 1) = "." Then    'yes
          MsgBox "YES" & Space(10), vbQuestion  ', "title" & vbCr &
    Else: MsgBox "NO" & Space(10), vbQuestion: End If ', "title"  & vbCr &: end if

        'RANGE ("A" & ActiveWindow.Panes(ActiveWindow.Panes.Count).VisibleRange.row + 1 & ":" & "A" & ActiveWindow.Panes(ActiveWindow.Panes.Count).VisibleRange.row + 5)'.Select  'YES
        'MsgBox "A" & ActiveWindow.Panes(ActiveWindow.Panes.Count).VisibleRange.row & Space(10), vbQuestion    'YES  result eg:  A2145
        'RANGE("A" & ActiveWindow.Panes(ActiveWindow.Panes.Count).VisibleRange.row).Select    '& Space(10), vbQuestion    'YES  top left pane, top left cell selected

    'ANS:  so far
        Dim rngXX As RANGE: Set rngXX = RANGE("A" & ActiveWindow.Panes(ActiveWindow.Panes.Count).VisibleRange.row + 1 & ":" & "A" & ActiveWindow.Panes(ActiveWindow.Panes.Count).VisibleRange.row + 5)  '.Select  'YES
        'Dim rngXX As RANGE: Set rngXX = RANGE("A" & ActiveWindow.Panes(ActiveWindow.Panes.Count).VisibleRange.row + 1): rngXX.Select 'FRIGGIN YES & ":" & "A" & ActiveWindow.Panes(ActiveWindow.Panes.Count).VisibleRange.row + 5)  '.Select  'YES
        'rngXX.Select  'YES  get if all cells in a range = a value

        'MsgBox Left(rngXX.Value, 1) & Space(10), vbQuestion   'YES  ANSWER (for single cell)
        'MsgBox rngXX.Value & Space(10), vbQuestion  'YES
        If Left(RANGE("a2132").RESIZE(5, 0).Value, 1) = "." Then  'no
        'If Left(RANGE("a2132").Value, 1) = "." Then   'yes
        'If Left(RANGE("a2132:a2135").Value, 1) = "." Then    'no
        'If Left(rngXX.Value, 1) = "." Then    'yes for single cell
          MsgBox "YES" & Space(10), vbQuestion  ', "title" & vbCr &
    Else: MsgBox "NO" & Space(10), vbQuestion: End If ', "title"  & vbCr &: end if

        'Cells(rnxx.row, D2).RESIZE(, 3).Select
        'Cells(activecell.row, D2).RESIZE(, 3).Select    'YES  inclusive, positive only? (3 cells in a row selected: CY99:CZ99)

        'Dim rngYY As RANGE: Set rngYY = RANGE("A" & ActiveWindow.Panes(ActiveWindow.Panes.Count).VisibleRange.row + 5): rngYY.Select   'YES
        'Dim rngYY As RANGE: Set rngYY = RANGE("A" & ActiveWindow.Panes(ActiveWindow.Panes.Count).VisibleRange.row)    'no
        'Dim rngZZ As RANGE: Set rngZZ = RANGE(rngYY.OFFSET(1, 0) & ":" & rngYY.OFFSET(6, 0))
        'RANGE(rngZZ & ":" & rngZZ.OFFSET(5, 1)).Select    'no,  no on commas,  WHAT  range rows cells
        'Cells(RANGE(rngZZ & ":" & rngZZ.OFFSET(5, 1))).Select    'no,  no on commas,  WHAT  range rows cells
        'Not Intersect(Target, RANGE(RANGE(G7), RANGE(G7).OFFSET(-10, 0))) Is Nothing   'eg
        'rngZZ.Select  'NO
        'rngYY.OFFSET(1, 0).Select   'yes
        'RANGE(rngYY & ":" & rngYY + 1).Select    'no
        'rngYY.Select   '< yes
    '    RANGE(rngYY, 1).OFFSET(5, 0).Select    'no    (ROW, COL)
        'Cells(rngYY, 1).RESIZE(5, 1).Select    'no    (ROW, COL)
        'Cells(rngYY, 1).OFFSET(, 1).RESIZE(, 6).Select    '?
        'Cells(ActiveCell.row, J6).OFFSET(, 1).RESIZE(, 6).Select   'eg cols?
        'Dim rngZZ As RANGE: Set rngZZ = RANGE(Cells(rngYY.row + 1, 1) & ":" & Cells(rngYY.row + 5, 1)) 'no  ck range stuff
    '    Dim rngXX As RANGE: Dim rngYY As RANGE: Set rngXX = Cells("A" & ActiveWindow.Panes(ActiveWindow.Panes.Count).VisibleRange.row)
    '    Set rngYY = RANGE(rngXX & ":" & rngXX + 5)   'no?
    '    rngYY.Select   'no?

    end if

    • Edited by Davexx Monday, October 8, 2018 8:46 AM
    Monday, December 11, 2017 9:16 AM

All replies

  • I am not sure if the following is what you are trying to do but if not then I will need an example copy of your data with a description of what you are trying to achieve.

    The code loops through all cells in column A and tests them for the dot and then applies the "Yes" or "No" to a column to the right with the Offset command.

    Note that where I use offset, the 0 (zero) is for rows (there is no offset for rows) and the 3 for columns. The number of columns is based on if you place the cursor in column A and then it is the number of times you need to press the right arrow to get to the required column (In the example it is column D where it inserts "Yes" or "No" so edit the 3 to match the column where you require the "Yes" or "No".

    Ensure that you backup you workbook before running the code because I am not sure it is what you want to do what you want.

    Sub test()

        Dim rngColA As Range
        Dim rCel As Range
        With ActiveSheet
            'Following line assigns cell A2 to the last used cell in column A to the range variable
            Set rngColA = .Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp))
        End With
        'Loop through all the cells in column A
        For Each rCel In rngColA
            If Left(rCel, 1) = "." Then
                'Following line inserts "Yes" 3 cells to right of column A (In column D)
                rCel.Offset(0, 3) = "Yes"
                'Following line inserts "Yes" 3 cells to right of column A (In column D)
                rCel.Offset(0, 3) = "No"
            End If
        Next rCel

    End Sub

    If the code does not work then upload an example workbook to OneDrive with a description of what you want to achieve.

    Guidelines to upload a workbook on OneDrive. (If you already use OneDrive and your process for saving to it is different then you can probably start at step 8 to get the link but please zip the file before uploading.)

    1. Zip your workbooks. Do not just save an unzipped workbook to OneDrive because the workbooks open with On-Line Excel and the limited functionality with the On-Line version causes problems.
    2. To Zip a file: In Windows Explorer Right click on the selected file and select Send to -> Compressed (zipped) folder). By holding the Ctrl key and left click once on each file, you can select multiple workbooks before right clicking over one of the selections to send to a compressed file and they will all be included into the one Zip file.
    3. Do not use 3rd party compression applications because I cannot unzip them. I do not clog up my computer with 3rd party apps when there are perfectly good apps supplied with windows.
    4. Go to this link.
    5. Use the same login Id and Password that you use for this forum.
    6. Select Upload in the blue bar across the top and browse to the zipped folder to be uploaded.
    7. Select Open (or just double click). (Be patient and give it time to display the file after initially seeing the popup indicating it is done.)
    8. Right click the file on OneDrive and select Share.
    9. Select "Get a Link" from the popup menu.
    10. Click in the field displaying the link and it should highlight and then Copy and Paste the link into your reply on this forum. (I suggest that you avoid the "Copy" button on the "Get a link" screen because it introduces additional steps that are not required.)

    Regards, OssieMac

    Tuesday, December 12, 2017 6:54 AM
  • hi,  thanks for your reply.  sorry not back sooner.  problems,  running bit slow & had a 2 week flu.

    i have been running into alot of work, problems..  trying to review all vb, upgrade my os etc..  i am not that fast at vb & it is quite a chore.  (eg no goog luck / post pending for find if cell or cells has any of an array of characters array = ("F", "G", "Z").  small syntax can kill me.  just realize that maybe need brackets.

    anyways, after i made the post (not sure if is the case here on your reply/ me..)  i should have given an example of vb i was trying to correct.  (pardon not sure if your eg covers this, will take me more time to review - understand..)

    how to be brief:  i use a vb that is activated by clicking on a cell (for that row / particular column) for example, to click on a work row that has a dot:  "." in column X where it will scroll that row to top of view  (left column A, 1  has a period for work rows),  if not a work row (column A has a name),  and is greater than 5 rows down from top of view,  then scroll down to that record clicked upon, clicking in column X.  :)  sorry.  eg below.

    problem is that if i have more than 5, 10 etc work rows with column X all have the said dots:  ".'  wanted clicked row to top of view.  problem:  greater than 5 rows down causes unwanted new scroll to next 5 rows (10 20 30... rows) to scroll to the next bottom position, where just wanted the first clicked top row.  (top row scrolling -1 for top of view).

    i think the proper answer for that would be different than for what asked in original post.

    i hope all that makes sense.  what missed saying is that i have a separate macro called goCYC()  cycle cursor down to next actual record line  (regardless of clicked row for scroll row destination),  causing the secondary scroll.

    pardon,  not able to get to your eg  now,  if answers question but this is just an update.  maybe awhile before can get back.  have a large project trying to accomplish..


    ==========    VB EG:  (update:  my luck it would be just an EVENTS OFF item somewhere)


    If 0 Then  'OUT EG
    If Target.row > RANGE(G8).row Then
    Set MyRange = Me.RANGE(B5).EntireColumn   '
    If Target.Cells.Count = 1 And Not Intersect(Target, MyRange) Is Nothing Then  'And Left(Target.Formula, 10) <> "=HYPERLINK" Then   'B5 sym  J4 x
        On Error Resume Next
        If activecell.row = ActiveWindow.Panes(ActiveWindow.Panes.Count).VisibleRange.row Or selection.Value = "." Or _
           activecell.row > 5 + ActiveWindow.Panes(ActiveWindow.Panes.Count).VisibleRange.row Or selection.Value = ".." Then    '>5 so: =6

              If 1 And activecell.Value = "." And selection.OFFSET(-1, 0).Value <> ".." Then
                  If Cells(activecell.row, J5).Text = "dn" Then ActiveWindow.ScrollRow = activecell.row - 1: goEXIT Else _
                                                                ActiveWindow.ScrollRow = activecell.row - 0: goEXIT
    'SCROLL1 -1    'WORK ROWS
              ElseIf 1 And Left(Cells(activecell.row, "A:A").Text, 1) <> "." Then
                  ActiveWindow.ScrollRow = activecell.row - 1             '<<  SCROLL ROW - 1
    'SCROLL2 -0   '(mid spacer lines)  (".." what is item makes not scroll 1 more row??)
              ElseIf 1 And selection.Value = ".." Or selection.OFFSET(-1, 0).Value = ".dn." And Target.row > RANGE(E5).row And selection.OFFSET(1, 0).Value <> "." Then
                  ActiveWindow.ScrollRow = activecell.row - 0
              End If
    'CURSOR MOVE:  need to limit when gocyc happens (need to stop secondary sroll rows..)
              Call goCYC          'cycle cursor down to next record (causes new scroll row if > 5 rows???   (replace all?: target. with selection. )
        End If: goMODE: goEXIT    'EVENTS     ': gohome
    End If: End If
    End If



    'gd 1508
    Sub goCYC()   'cycle cursor down col (to the first name / record line)
        Dim B5 As String: B5 = RANGE("B5")
        If selection.Count > 1 Then goEXIT
        If selection.Column = RANGE(B5).Column Then
        Dim i As Long   'Down a column move cursor..  KEEP
        i = 1   '(DIRECTION: 1 fwd, -1 rev, then set i,0 offset order same in both items below
        If selection.HorizontalAlignment = xlCenter Then    'srch: OSXXX  (offset select)
            While selection.OFFSET(i, 0).HorizontalAlignment = xlCenter And selection.OFFSET(i, 0).Value = "." Or selection.OFFSET(i, 0).Value = ".." Or _
              selection.OFFSET(i, 0).Value = ".dn."     'YES  (row, col) cols, ?skips hidden cols
              i = i + 1
        selection.OFFSET(i, 0).Activate: goEXIT                 'rows,  orig
        End If
    '    selection.OFFSET(i, 0).Activate                 'rows,  orig  did not help ".."
        End If
    End Sub   'gocyc() GOCYC()

    Wednesday, December 27, 2017 3:55 PM
  • Hi Davexx,

    I am not sure whether your issue has been resolved or not. It seems it resolved temporarily.

    If your issue has resolved, I would suggest you mark the your reply as answer to close this thread.

    If you have any new issue while processing your project, please feel free to post a new thread.



    Help each other

    Thursday, December 28, 2017 7:09 AM
  • hi,  thanks for the reply.  just everything going slower than expected. i am checking this item next but might be couple of days..  i have not been able to check your example yet, so no worries, but if relevant i had idea seen somewhere example for:

    if from current position down, if cell contains any more rows count of array? (".","..",".dn.") >5 then exit sub

    or like:  if selection.rowcount down equals array (above) > 5 then exit sub

    will get back on this as soon as i can.  thanks.

    it is activated by clicking cell in a column, same column, but if needed, can identify the column, relevant eg?:  Cells(activecell.row, B5).Select

    i think one problem ran into was once the cursor "goCYC" -les down the column, may interfere with what "is" the from:  "selection" down idea.  (i've ran into that before), where the first selection was no longer valid.

    pardon the delay.
    • Edited by Davexx Monday, April 2, 2018 7:16 AM
    Monday, April 2, 2018 7:09 AM
  • just seeing my original post - again.  i think my over-writing.. may have been off point and ask pardon for that, aside from maybe did not know how to write it, may have been up during bunch of 24 hour periods.  title isn't even right.  skipping column A left,1 = "."


    181007    hi,  thanks for the reply.  been a long time but getting back on some of this.  this deserves to be checked and closed by me as soon as can.  apologies for making long posts..  i am trying to apply your solution,  just not sure if i get it yet.

    i may have found a partial solution below, but think i see some problems with multiple vb's doing different scrolls? and making the goCYC vb run out of control.  i just realized that and still have some work to do there.


    answer will be to combine those vb's & have one boolean if-then to separate them.  this turns out to be a small problem where i just turned the goCYC vb off.  in a word problem:


    if range(selection.offset(3,0), selection) consecutive cells = "." or ".." or ".dn." is > 4 then goexit, else goCYC  (where gocyc is cycle cursor down a column to first work row, once clicked header row in current location).


    i would have thought the following would work,  but only for 3? rows (not testing consecutive rows), where rows: 

    work - record - work - work would get a false positive on 3 "." dots?  what got:

    (i still need to limit to consecutive cells, and combine other vb)

        If application.WorksheetFunction.CountIf(Range(activecell.OFFSET(2, 0), activecell), ".") > 2 Then goEXIT Else goCYC   'no?   (Should be same number? getting +1 somehow)
        'Range(activecell.OFFSET(4, 0), activecell).Select    'YES?  SELECTS A RANGE OF CELLS EG OFF 4 GETS 5 CELLS



    if not said yet, i don't really need a reply to this yet, as am still working on it.  i will check your vb & post back as soon as can, but the IF-countif above might work, still working on other critical - major overhaul.

    i don't want to include it here, if not too small of an idea i made use of message box vb work arounds to help test these items.  i will make a separate post on that.  thanks,  will get back.


    other:  the thing with finding characters in a cell,  where a loop did not test for zero, i have been working on a couple of solutions, will see how far can take them but 1 eg is below.  if needed i will make separate post on that.  (took me alot of work to get that, 1 prob:  many tests can take much space finding eg's:  "A" "B" "C"..., but have some solutions for that)  eg:


    Function isA_eg(ByRef x As Range) As Boolean: On Error Resume Next: isA_eg = False   'call as:  =if(isA(CY900),1,0)
        Dim findX As Range
        Set findX = x.find("S", LookAt:=xlPart, MatchCase:=True): If Not findX Is Nothing Then isA_eg = True
    End Function

    • Edited by Davexx Monday, October 8, 2018 8:37 AM
    Monday, October 8, 2018 8:02 AM