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

hjameelq

08-15-2016, 03:25 AM

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!

gmaxey

08-15-2016, 06:18 AM

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

Paul_Hossler

08-15-2016, 06:33 AM

Hmmm - double posted ??

Paul_Hossler

08-15-2016, 06:44 AM

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

gmaxey

08-15-2016, 06:56 AM

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.

Paul_Hossler

08-15-2016, 06:57 AM

If the text is in a different font, you could look for that --- cell by cell

gmaxey

08-15-2016, 07:11 AM

Paul,

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

Paul_Hossler

08-15-2016, 08:38 AM

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

hjameelq

08-15-2016, 08:41 AM

Thanks it worked :)

Can I ask another question:

Is there way to convert Arabic numbers to English numbers.

Thanks,

gmaxey

08-15-2016, 09:43 AM

Paul, thanks for the explanation and examples.

Paul_Hossler

08-15-2016, 10:02 AM

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

hjameelq

08-15-2016, 11:50 AM

Ya look at that:

١

٣

٤

٤

٥

١

٢

١

٣

٤

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

Paul_Hossler

08-15-2016, 01:17 PM

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

hjameelq

08-16-2016, 04:06 AM

Thanks Paul, it perfectly worked.

Paul_Hossler

08-16-2016, 08:11 AM

Glad

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

Powered by vBulletin® Version 4.2.5 Copyright © 2020 vBulletin Solutions Inc. All rights reserved.