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!
I am just a dabbler so something far better may come along. For the first part:
Code: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
Hmmm - double posted ??
Uses intrinsic Excel capability (Filter) to avoid looping
Code: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
Code: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,
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.
If the text is in a different font, you could look for that --- cell by cell
Paul,
Never mind the part about text returning > 18. That doesn't seem to be the case now :-)
Actually, looking (and thinking) a little more, the original was unnecessarily complex with an unneeded IntersectQuote:
Originally Posted by gmaxey
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)Code: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
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
Thanks it worked :)
Can I ask another question:
Is there way to convert Arabic numbers to English numbers.
Thanks,
Paul, thanks for the explanation and examples.
1. You're welcomeQuote:
Originally Posted by hjameelq
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
Ya look at that:
١ ٣ ٤ ٤ ٥ ١ ٢
١ ٣ ٤
These numbers are written in Arabic, can we convert them to English like 1, 2, 3, 4, 5,
This is the best I could come up with
Code: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
Thanks Paul, it perfectly worked.
Glad
There's ways to reduce the line count, but I opted for simplicity