ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Code Help Needed (https://www.excelbanter.com/excel-programming/310409-code-help-needed.html)

Michael168[_116_]

Code Help Needed
 

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

--
Michael16
-----------------------------------------------------------------------
Michael168's Profile: http://www.excelforum.com/member.php...info&userid=60
View this thread: http://www.excelforum.com/showthread.php?threadid=26126


Tom Ogilvy

Code Help Needed
 
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

--
Regards,
Tom Ogilvy

"Michael168" wrote in message
...

Hi !

Can someone help me to modify the code below?

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

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

I hope I have clearly explained. Please kindly add in or modify the
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,
Michael


--
Michael168
------------------------------------------------------------------------
Michael168's Profile:

http://www.excelforum.com/member.php...nfo&userid=605
View this thread: http://www.excelforum.com/showthread...hreadid=261268




Patrick Molloy[_4_]

Code Help Needed
 
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


--
Patrick Molloy
Microsoft Excel MVP
---------------------------------
I Feel Great!
---------------------------------
"Michael168" wrote in message
...

Hi !

Can someone help me to modify the code below?

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

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

I hope I have clearly explained. Please kindly add in or modify the
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,
Michael


--
Michael168
------------------------------------------------------------------------
Michael168's Profile:
http://www.excelforum.com/member.php...nfo&userid=605
View this thread: http://www.excelforum.com/showthread...hreadid=261268





All times are GMT +1. The time now is 10:07 PM.

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