Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Better code needed | Excel Programming | |||
Code Fix Needed | Excel Programming | |||
VBA code Help needed | Excel Programming | |||
Fw:code needed | Excel Programming | |||
code needed | Excel Programming |