Consulting

Results 1 to 15 of 15

Thread: VBA Code to go through one column cells, I don't have range, I have only one column?

  1. #1
    VBAX Newbie
    Joined
    Aug 2016
    Posts
    5
    Location

    VBA Code to go through one column cells, I don't have range, I have only one column?

    I need to make a loop and go through column cells, I want to check if the value of cell is greater than 18.

    Also, there is another issue is how can i detect the cells with arabic text, I need to highlight these cells in whole sheet not only in specific range!

  2. #2
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,334
    Location
    I am just a dabbler so something far better may come along. For the first part:

    Sub ScratchMacro()
    'A basic Word macro coded by Greg Maxey
    Dim lngCount As Long, lngIndex As Long
      lngCount = Cells(Rows.Count, "A").End(xlUp).Row
      For lngIndex = 1 To lngCount
        If IsNumeric(Cells(lngIndex, "A").Value) And Cells(lngIndex, "A").Value > 18 Then
          Cells(lngIndex, "B").Value = "Flagged"
         End If
        Next lngIndex
    lbl_Exit:
      Exit Sub
    End Sub
    Greg

    Visit my website: http://gregmaxey.com

  3. #3
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    Hmmm - double posted ??
    Last edited by Paul_Hossler; 08-15-2016 at 06:45 AM.
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  4. #4
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    Uses intrinsic Excel capability (Filter) to avoid looping


    Option Explicit
    Const iLimit As Long = 18
    
    Sub HighlightCells()
        
        ActiveSheet.Range("$A$1").CurrentRegion.AutoFilter Field:=1, Criteria1:=">" & iLimit, Operator:=xlAnd
        
        On Error Resume Next
        Intersect(ActiveSheet.Columns(1).SpecialCells(xlCellTypeVisible), ActiveSheet.AutoFilter.Range).Interior.Color = vbRed
        On Error GoTo 0
        
        ActiveSheet.AutoFilterMode = False
    
    End Sub


    You might have to tweak it if there's column headers

    Option Explicit
    Const iLimit As Long = 18
    Sub HighlightCells()
        Dim r As Range
        
        With ActiveSheet
            .Range("$A$1").CurrentRegion.AutoFilter Field:=1, Criteria1:=">" & iLimit, Operator:=xlAnd
        
            On Error Resume Next
            Set r = Intersect(.Columns(1).SpecialCells(xlCellTypeVisible), .AutoFilter.Range)
            Set r = Intersect(r, Range(.Rows(2), .Rows(.Rows.Count)))
            r.Interior.Color = vbGreen
            On Error GoTo 0
        
            .AutoFilterMode = False
        End With
    End Sub
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  5. #5
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,334
    Location
    Paul,

    The dabbler (me) is trying to learn a little about Excel. Can you offer a little explanation on "Intersect" (how it works in this case) and while probably unlikely, if the column of interest has both numbers and text the filter considers text as > 18. How would you modify the filter so that it only returns numeric values >18? Thanks.
    Greg

    Visit my website: http://gregmaxey.com

  6. #6
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    If the text is in a different font, you could look for that --- cell by cell
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  7. #7
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,334
    Location
    Paul,

    Never mind the part about text returning > 18. That doesn't seem to be the case now :-)
    Greg

    Visit my website: http://gregmaxey.com

  8. #8
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    Quote Originally Posted by gmaxey View Post
    Paul,

    The dabbler (me) is trying to learn a little about Excel. Can you offer a little explanation on "Intersect" (how it works in this case) and while probably unlikely, if the column of interest has both numbers and text the filter considers text as > 18. How would you modify the filter so that it only returns numeric values >18? Thanks.
    Actually, looking (and thinking) a little more, the original was unnecessarily complex with an unneeded Intersect

    Sub HighlightCellsBetter()
        Dim r As Range
         
        With ActiveSheet
            .Range("$A$1").CurrentRegion.AutoFilter Field:=1, Criteria1:=">" & iLimit, Operator:=xlAnd
             
            On Error Resume Next
            Set r = .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible)
            Set r = Intersect(r, Range(.Rows(2), .Rows(.Rows.Count)))
            r.Interior.Color = vbRed
            On Error GoTo 0
             
            .AutoFilterMode = False
        End With
    End Sub
    First Set r = the worksheet's (Activesheet) data block that is filtered ( .AutoFilter.Range) only the first column and only the cells that are visible (i.e. not filtered out)

    This includes (probably) the column header in typically A1

    Range(.Rows(2), .Rows(.Rows.Count)) is the range for the WS rows2 - the last row (.Rows.Count) -- used to be 65K rows max, now 1M+, so I don't like to hard code assumptions

    So the second Set r = is the cells in rows 2 - end that are also visible in the original block of filtered data

    I'm reusing the variable r, but it could be Set r2 = Intersect(r, Range(.Rows(2), .Rows(.Rows.Count)))

    Single step through the attachment and you'll get it
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  9. #9
    VBAX Newbie
    Joined
    Aug 2016
    Posts
    5
    Location
    Thanks it worked
    Can I ask another question:

    Is there way to convert Arabic numbers to English numbers.

    Thanks,

  10. #10
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,334
    Location
    Paul, thanks for the explanation and examples.
    Greg

    Visit my website: http://gregmaxey.com

  11. #11
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    Quote Originally Posted by hjameelq View Post
    Thanks it worked
    Can I ask another question:

    Is there way to convert Arabic numbers to English numbers.

    Thanks,
    1. You're welcome

    2. Sure

    3. Strictly speaking, '0', '1', ... '9' are Arabic numbers, as opposed to 'I', 'V', ..., '"M' which are Roman numerals

    Can you post an example since I don't think that's what you meant.

    It 'might' be possible to replace 'Arabic 1' with '1', 'Arabic 2' with '2','Arabic 3' with '3', etc. on a character by character basis
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  12. #12
    VBAX Newbie
    Joined
    Aug 2016
    Posts
    5
    Location
    Ya look at that:
    ١
    ٣
    ٤
    ٤
    ٥
    ١
    ٢
    ١
    ٣
    ٤

    These numbers are written in Arabic, can we convert them to English like 1, 2, 3, 4, 5,

  13. #13
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    This is the best I could come up with



    Option Explicit
    Function Arabic2English(s As String) As String
        Dim s1 As String, s2 As String
        Dim i As Long
        
        For i = 1 To Len(s)
            Select Case Mid(s, i, 1)
                Case ChrW(1632):  s1 = s1 & ChrW(48)
                Case ChrW(1633):  s1 = s1 & ChrW(49)
                Case ChrW(1634):  s1 = s1 & ChrW(50)
                Case ChrW(1635):  s1 = s1 & ChrW(51)
                Case ChrW(1636):  s1 = s1 & ChrW(52)
                Case ChrW(1637):  s1 = s1 & ChrW(53)
                Case ChrW(1638):  s1 = s1 & ChrW(54)
                Case ChrW(1639):  s1 = s1 & ChrW(55)
                Case ChrW(1640):  s1 = s1 & ChrW(56)
                Case ChrW(1641):  s1 = s1 & ChrW(57)
                Case Else
                    s1 = s1 & Mid(s, i, 1)
            End Select
        Next i
        
        Arabic2English = s1
    End Function
    
    
    Function English2Arabic(s As String) As String
    
        Dim s1 As String, s2 As String
        Dim i As Long
        
        s1 = StrConv(s, vbUnicode)
        
        For i = 1 To Len(s1)
            Select Case Mid(s1, i, 1)
                Case ChrW(48):  s2 = s2 & ChrW(1632)
                Case ChrW(49):  s2 = s2 & ChrW(1633)
                Case ChrW(50):  s2 = s2 & ChrW(1634)
                Case ChrW(51):  s2 = s2 & ChrW(1635)
                Case ChrW(52):  s2 = s2 & ChrW(1636)
                Case ChrW(53):  s2 = s2 & ChrW(1637)
                Case ChrW(54):  s2 = s2 & ChrW(1638)
                Case ChrW(55):  s2 = s2 & ChrW(1639)
                Case ChrW(56):  s2 = s2 & ChrW(1640)
                Case ChrW(57):  s2 = s2 & ChrW(1641)
                Case Else
                    s2 = s2 & Mid(s1, i, 1)
            End Select
        Next i
        
        English2Arabic = s2
    End Function
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  14. #14
    VBAX Newbie
    Joined
    Aug 2016
    Posts
    5
    Location
    Thanks Paul, it perfectly worked.

  15. #15
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    Glad

    There's ways to reduce the line count, but I opted for simplicity
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •