Code Help Needed

[Michael168]

Hi !

Can someone help me to modify the code below?

The module start from the last row, read Columns "D" & "E" then fil
the values into Columns "K" to "R".

I need to add in one condition i.e. whenever it encounters the firs
Column "K" is "NOT EMPTY" then "EXIT THE SUB" otherwise continue t
process until the first "Col K" is "NOT EMPTY". Many rows of datas ar
add in everyday to "Col D & Col E". So to speed up the updating proces
I just need to update "Col K" to "Col R" that have not been update
instead of running the code from the last row until the first row fo
every execution.

I hope I have clearly explained. Please kindly add in or modify th
code.

SUB FILLDATA()

DIM MYRANGE AS RANGE
DIM MYROW AS LONG
DIM I AS INTEGER
DIM J AS INTEGER
DIM MYCNT AS INTEGER

WITH ACTIVESHEET.USEDRANGE
MYROW = .ROWS(.ROWS.COUNT).ROW
END WITH

WHILE MYROW > 0
MYCNT = 0
SET MYRANGE = RANGE(\"D\" & MYROW & \":E\" & MYROW)
FOR I = 1 TO -MYROW + 2 STEP -1
FOR J = 1 TO 2
IF APPLICATION.COUNTIF(RANGE(\"K\" & MYROW & \":R\" & MYROW), _
MYRANGE.CELLS(I, J).VALUE) = 0 THEN
IF ISEMPTY(RANGE(\"K\" & MYROW)) THEN
RANGE(\"K\" & MYROW).VALUE = MYRANGE.CELLS(I, J).VALUE
RANGE(\"L\" & MYROW).RESIZE(1, 7).CLEARCONTENTS
ELSE
RANGE(\"IV\" & MYROW).END(XLTOLEFT)(1, 2).VALUE = _
MYRANGE.CELLS(I, J).VALUE
END IF
MYCNT = MYCNT + 1
IF MYCNT = 8 THEN GOTO FOUND8:
END IF
NEXT J
NEXT I
FOUND8:
MYROW = MYROW - 1
WEND

END SUB


Regards,
Michae

 

[Tom Ogilvy]

Sub FILLDATA()

Dim MYRANGE As Range
Dim MYROW As Long
Dim I As Integer
Dim J As Integer
Dim MYCNT As Integer

With ActiveSheet.UsedRange
MYROW = .Rows(.Rows.Count).Row
End With

While MYROW > 0
If Not IsEmpty(Cells(MYROW, "K")) Then Exit Sub
MYCNT = 0
Set MYRANGE = Range("D" & MYROW & ":E" & MYROW)
For I = 1 To -MYROW + 2 Step -1
For J = 1 To 2
If Application.CountIf(Range("K" & MYROW & ":R" & MYROW), _
MYRANGE.Cells(I, J).Value) = 0 Then
If IsEmpty(Range("K" & MYROW)) Then
Range("K" & MYROW).Value = MYRANGE.Cells(I, J).Value
Range("L" & MYROW).Resize(1, 7).ClearContents
Else
Range("IV" & MYROW).End(xlToLeft)(1, 2).Value = _
MYRANGE.Cells(I, J).Value
End If
MYCNT = MYCNT + 1
If MYCNT = 8 Then GoTo FOUND8:
End If
Next J
Next I
FOUND8:
MYROW = MYROW - 1
Wend

End Sub

 

[Patrick Molloy]

not really clear on what this sub does...but...

Sub FillData()

Dim MyRange As Range
Dim MyRow As Long
Dim i As Integer
Dim j As Integer
Dim MyCnt As Integer

With ActiveSheet.UsedRange
For MyRow = .Rows(.Rows.Count).Row To 1 Step -1

MyCnt = 0
Set MyRange = Range("D" & MyRow & ":E" & MyRow)
For i = 1 To -MyRow + 2 Step -1
For j = 1 To 2
If Cells(MyRow, "K").Value = "NOT EMPTY" Then Exit Sub
If Application.CountIf(Range("K" & MyRow & ":R" &
MyRow), _
MyRange.Cells(i, j).Value) = 0 Then
If IsEmpty(Range("K" & MyRow)) Then
Range("K" & MyRow).Value = MyRange.Cells(i,
j).Value
Range("L" & MyRow).Resize(1, 7).ClearContents
Else
Range("IV" & MyRow).End(xlToLeft)(1, 2).Value =
_
MyRange.Cells(i, j).Value
End If
MyCnt = MyCnt + 1
If MyCnt = 8 Then Exit For
End If
Next j
Next i
Next
End With
End Sub