Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default 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

  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 27,285
Default 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



  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 103
Default 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



Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Better code needed ceplane Excel Programming 6 May 10th 04 07:59 PM
Code Fix Needed Phil Hageman[_3_] Excel Programming 2 February 28th 04 01:16 AM
VBA code Help needed liamothelegend Excel Programming 1 November 5th 03 12:25 PM
Fw:code needed ibo Excel Programming 2 August 5th 03 09:30 PM
code needed ibo Excel Programming 0 July 29th 03 05:32 PM


All times are GMT +1. The time now is 11:45 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"