ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Faster Way of looping through cells (https://www.excelbanter.com/excel-programming/337122-faster-way-looping-through-cells.html)

Andibevan[_4_]

Faster Way of looping through cells
 
Hi All,

Is there a faster way of achieving the following loop:-

It checks through the range and ensures the last value in each cell is a
hard carriage return. It does not act on blank cells.

Sub add_hard_carriage()
Dim start_r As Integer, last_r As Integer
Dim const_Range As Range
Dim wsNM As Worksheet
Dim CurCell As Object 'As Range
Dim var_Chk As Integer

Set wsNM = Sheets("Project Log Form")

start_r = 9 'Start Row on data sheet
last_r = wsNM.Range("A65536").End(xlUp).Row 'last row

Set const_Range = wsNM.Range("T" & start_r & ":T" & last_r) 'Range
containing information

For Each CurCell In const_Range

If CurCell.Value < "" Then

var_Chk = Asc(Right(CurCell, 1))
If var_Chk < 10 Then
CurCell.Value = CurCell.Value & Chr(10)
End If

End If
Next CurCell

End Sub



Tom Ogilvy

Faster Way of looping through cells
 
Sub add_hard_carriage()
Dim start_r As Integer, last_r As Integer
Dim const_Range As Variant
Dim wsNM As Worksheet
Dim CurCell As Variant
Dim var_Chk As Integer
Dim rng as Range
Dim i as Long
Set wsNM = Sheets("Project Log Form")

start_r = 9 'Start Row on data sheet
last_r = wsNM.Range("A65536").End(xlUp).Row 'last row
set rng = wsNM.Range("T" & start_r & ":T" & last_r)
const_Range = rng.Value
i = 0
For Each CurCell In const_Range
i = i + 1
If CurCell < "" Then

var_Chk = Asc(Right(CurCell, 1))
If var_Chk < 10 Then
rng(i).Value = CurCell.Value & Chr(10)
End If

End If
Next CurCell

End Sub


--
Regards,
Tom Ogilvy

"Andibevan" wrote in message
...
Hi All,

Is there a faster way of achieving the following loop:-

It checks through the range and ensures the last value in each cell is a
hard carriage return. It does not act on blank cells.

Sub add_hard_carriage()
Dim start_r As Integer, last_r As Integer
Dim const_Range As Range
Dim wsNM As Worksheet
Dim CurCell As Object 'As Range
Dim var_Chk As Integer

Set wsNM = Sheets("Project Log Form")

start_r = 9 'Start Row on data sheet
last_r = wsNM.Range("A65536").End(xlUp).Row 'last row

Set const_Range = wsNM.Range("T" & start_r & ":T" & last_r) 'Range
containing information

For Each CurCell In const_Range

If CurCell.Value < "" Then

var_Chk = Asc(Right(CurCell, 1))
If var_Chk < 10 Then
CurCell.Value = CurCell.Value & Chr(10)
End If

End If
Next CurCell

End Sub





Andibevan[_3_]

Faster Way of looping through cells
 
How would this make it faster?

"Tom Ogilvy" wrote in message
...
Sub add_hard_carriage()
Dim start_r As Integer, last_r As Integer
Dim const_Range As Variant
Dim wsNM As Worksheet
Dim CurCell As Variant
Dim var_Chk As Integer
Dim rng as Range
Dim i as Long
Set wsNM = Sheets("Project Log Form")

start_r = 9 'Start Row on data sheet
last_r = wsNM.Range("A65536").End(xlUp).Row 'last row
set rng = wsNM.Range("T" & start_r & ":T" & last_r)
const_Range = rng.Value
i = 0
For Each CurCell In const_Range
i = i + 1
If CurCell < "" Then

var_Chk = Asc(Right(CurCell, 1))
If var_Chk < 10 Then
rng(i).Value = CurCell.Value & Chr(10)
End If

End If
Next CurCell

End Sub


--
Regards,
Tom Ogilvy

"Andibevan" wrote in message
...
Hi All,

Is there a faster way of achieving the following loop:-

It checks through the range and ensures the last value in each cell is a
hard carriage return. It does not act on blank cells.

Sub add_hard_carriage()
Dim start_r As Integer, last_r As Integer
Dim const_Range As Range
Dim wsNM As Worksheet
Dim CurCell As Object 'As Range
Dim var_Chk As Integer

Set wsNM = Sheets("Project Log Form")

start_r = 9 'Start Row on data sheet
last_r = wsNM.Range("A65536").End(xlUp).Row 'last row

Set const_Range = wsNM.Range("T" & start_r & ":T" & last_r) 'Range
containing information

For Each CurCell In const_Range

If CurCell.Value < "" Then

var_Chk = Asc(Right(CurCell, 1))
If var_Chk < 10 Then
CurCell.Value = CurCell.Value & Chr(10)
End If

End If
Next CurCell

End Sub







Tom Ogilvy

Faster Way of looping through cells
 
Don't use it.
--
Regards,
Tom Ogilvy

"Andibevan" wrote in message
...
How would this make it faster?

"Tom Ogilvy" wrote in message
...
Sub add_hard_carriage()
Dim start_r As Integer, last_r As Integer
Dim const_Range As Variant
Dim wsNM As Worksheet
Dim CurCell As Variant
Dim var_Chk As Integer
Dim rng as Range
Dim i as Long
Set wsNM = Sheets("Project Log Form")

start_r = 9 'Start Row on data sheet
last_r = wsNM.Range("A65536").End(xlUp).Row 'last row
set rng = wsNM.Range("T" & start_r & ":T" & last_r)
const_Range = rng.Value
i = 0
For Each CurCell In const_Range
i = i + 1
If CurCell < "" Then

var_Chk = Asc(Right(CurCell, 1))
If var_Chk < 10 Then
rng(i).Value = CurCell.Value & Chr(10)
End If

End If
Next CurCell

End Sub


--
Regards,
Tom Ogilvy

"Andibevan" wrote in message
...
Hi All,

Is there a faster way of achieving the following loop:-

It checks through the range and ensures the last value in each cell is

a
hard carriage return. It does not act on blank cells.

Sub add_hard_carriage()
Dim start_r As Integer, last_r As Integer
Dim const_Range As Range
Dim wsNM As Worksheet
Dim CurCell As Object 'As Range
Dim var_Chk As Integer

Set wsNM = Sheets("Project Log Form")

start_r = 9 'Start Row on data sheet
last_r = wsNM.Range("A65536").End(xlUp).Row 'last row

Set const_Range = wsNM.Range("T" & start_r & ":T" & last_r) 'Range
containing information

For Each CurCell In const_Range

If CurCell.Value < "" Then

var_Chk = Asc(Right(CurCell, 1))
If var_Chk < 10 Then
CurCell.Value = CurCell.Value & Chr(10)
End If

End If
Next CurCell

End Sub









Alan Beban[_2_]

Faster Way of looping through cells
 
Tom Ogilvy wrote:
Don't use it.

Substitute the following for the corrersponding portion of Tom Ogilvy's
code; it loops through the array instead of through the worksheet range,
then dumps the array to the worksheet which is where the efficiency
comes from.


i = 0
For Each CurCell In const_Range
i = i + 1
If CurCell < "" Then
var_Chk = Asc(Right(CurCell, 1))
If var_Chk < 10 Then
const_Range(i, 1) = CurCell & Chr(10)
End If
End If
Next CurCell
rng.Value = const_Range

Alan Beban

Tom Ogilvy

Faster Way of looping through cells
 
As written, the code loops through the array and not the range. If no or
few corrections were needed (which I perceived to be the case), it would
avoid the unnecessary overhead of mindlessly writing the entire array back
to the sheet and incurring that overhead. The question then is how many
corrections have to be made before dumping the entire array back becomes
more beneficial. This would also depend on the extent of the range being
checked.

--
Regards,
Tom Ogilvy

"Alan Beban" wrote in message
...
Tom Ogilvy wrote:
Don't use it.

Substitute the following for the corrersponding portion of Tom Ogilvy's
code; it loops through the array instead of through the worksheet range,
then dumps the array to the worksheet which is where the efficiency
comes from.


i = 0
For Each CurCell In const_Range
i = i + 1
If CurCell < "" Then
var_Chk = Asc(Right(CurCell, 1))
If var_Chk < 10 Then
const_Range(i, 1) = CurCell & Chr(10)
End If
End If
Next CurCell
rng.Value = const_Range

Alan Beban




Alan Beban[_2_]

Faster Way of looping through cells
 
Tom Ogilvy wrote:
As written, the code loops through the array and not the range. If no or
few corrections were needed (which I perceived to be the case), it would
avoid the unnecessary overhead of mindlessly writing the entire array back
to the sheet and incurring that overhead. The question then is how many
corrections have to be made before dumping the entire array back becomes
more beneficial. This would also depend on the extent of the range being
checked.

Understood. But I didn't perceive either that the range being checked
was not extensive nor that no or few corrections were needed; else I
wouldn't expect a post asking for a faster way of looping through cells,
since the originally posted code would already be relatively fast.

Alan Beban


All times are GMT +1. The time now is 01:59 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com