Need help with FOR NEXT LOOP

[Wil]

I am new using VBA and need assistance with a FOR NEXT loop. What I need is
a subroutine that will detect a change in a range of cells in a ROW, and in
the last cell of the row, put in the date that any one of the cells in the
range was updated. Then, I need the subroutine to go to the subsequent row
and do the same process, until the subroutine encounters an empty range and
stop.

For example, if any data changes in (B2:E2), then place the date it was
changed in F2. Then go to the subsequent range (B3:E3) and then enter the
date that any data in the range was changed in F3. And then to keep checking
each row until there are no more rows to check.

A B C D E F
Part Unit Unit Pack Pack Date
Cost Rtl Cost Rtl Changed
A123 0.30 0.35 2.00 4.00 10/1/07
B234 0.45 0.40 3.00 5.00 09/1/07
C345 0.55 0.60 4.00 6.00


I saw a subroutine in a previous posting from Joerg Mochikun, but because
I'm not familiar with properly constructing a LOOP, i could only use it for a
single row:


Private Sub Worksheet_Change(ByVal Target As Range)
Dim txt
For Each cell In Range("B2:E2")
txt = txt & cell.Text
Next
If txt <> Range("F1") Then
Range("G1") = "Last change: " & Now()
Range("F1") = txt
End If
End Sub


I think if I could construct a LOOP that incorporates the above sub then I
can get the results I need. Any help and guidance is greatly appreciated.
Thank you - Wil

 

[carlo]

Hi Wil

actually you don't have to go through each row, because the
worksheet_change function gives you the address of the changed cell.
So you just have to check, if the changed cell is in the range you
want to and then update the row in which this cell is:
-----------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)

Dim row_ As Integer
Dim max_row As Integer

row_ = Target.Row
max_row = 100

If row_ > 1 And row_ < max_row And _
Target.Column < 6 Then
Range("F" & row_).Value = Now
End If

End Sub
-----------------------------------------------------
you can adjust max_row to whatever row you want.

If you have any questions for the code, just ask.

hth

Carlo

 

[Basilisk96]

Private Sub Worksheet_Change(ByVal Target As Range)

Dim row_ As Integer
Dim max_row As Integer

row_ = Target.Row
max_row = 100

If row_ > 1 And row_ < max_row And _
Target.Column < 6 Then
Range("F" & row_).Value = Now
End If

End Sub

Here's an even more generic solution, in case your data table is out
in the middle of a sheet somewhere:
======================================
Const MIN_COL = 1 'your left-boundary column
Const MAX_COL = 5 'your right-boundary column
Const MIN_ROW = 3 'row where data table starts
Const MAX_ROW = 65536 'last possible row for your table
Const LOG_COL = 6 'the column in each row where the date is logged

Private Sub Worksheet_Change(ByVal Target As Range)
With Target
r = .Row
c = .Column
Debug.Print r, c
If r >= MIN_ROW And r <= MAX_ROW Then
If c >= MIN_COL And c <= MAX_COL Then
Cells(r, LOG_COL).Value = Now()
End If
End If
End With
End Sub
======================================

Cheers,
-Basilisk96

 

[Basilisk96]

P.S.
1. Remove the Debug.Print line, it was just for diagnostics.
2. If you're going to declare the variables for row/column indices,
declare them as Long, not Integer... you've been warned

Cheers,
-Basilisk96

 

[Chip Pearson]

You don't need to loop. Use the following code in the sheet module for the
worksheet you want to change. Change the value of DETECT_RANGE to the
address of the range whose changes you want to react to. Change the value
of DATE_FORMAT to the date/time format you want the format you want to the
date/time stamp to use.

Private Sub Worksheet_Change(ByVal Target As Range)

Const DETECT_RANGE = "A1:E10" '<<< CHANGE
Const DATE_FORMAT = "dd-mmmy-yyyy hh:mm" '<<< CHANGE

On Error GoTo ErrH:
If Target.Cells.Count > 1 Then
Exit Sub
End If
If Not Application.Intersect(Target, Me.Range(DETECT_RANGE)) Is Nothing Then
Application.EnableEvents = False
Target.EntireRow.Cells(1, "F").Value = _
Format(Now, DATE_FORMAT)
End If
ErrH:
Application.EnableEvents = True

End Sub


--
Cordially,
Chip Pearson
Microsoft MVP - Excel, 10 Years
Pearson Software Consulting
www.cpearson.com
(email on the web site)