Do Until ActiveCell is empty

22,809

I am not changing anything in the logic. Just correcting the mistake.

Rewrite your sub as:

Sub test1()
    initialVal.offset(1,0).Select         'You have to move 1 cell down from your initial cell  
    Set nextVal = objExcel.ActiveCell
    Do until IsEmpty(nextVal)

        '----------->GUI pasting code<---------------

        nextVal.Offset(1, 0).Select
        Set nextVal = objExcel.ActiveCell    
    Loop
End Sub

Here's another way to achieve the job. It does not require to select the cells and do the offset again and again. You can directly fetch the required values from the cells.

Dim objExcel, objWb, objSheet, rows, i, tempVal
Set objExcel = CreateObject("Excel.Application")
Set objWb = objExcel.Workbooks.Open("C:\test.xlsx")
Set objSheet = objWb.Worksheets("sheet1")
rows = objSheet.usedrange.rows.count
for i=2 to rows step 1
    tempVal = objSheet.Cells(i,7)
    If IsEmpty(tempVal) then
        Exit For 
    Else
        'Call your function which pastes the tempVal to GUI
    End If  
Next
objWb.Close
objExcel.Quit
Set objSheet = Nothing
Set objWb = Nothing
Set objExcel = Nothing
Share:
22,809
CodeSpy
Author by

CodeSpy

Updated on July 09, 2022

Comments

  • CodeSpy
    CodeSpy over 1 year

    With the below code I am trying to copy a value from an XLS (initialVal) and paste to a GUI text field. Then, I want to enter a loop and get the next value (nextVal) using the ActiveCell call and offset (move down one row). I want to keep retrieving(and pasting to GUI) the next value in the next row (same column) until it finds an empty cell.

    With the code below that I am working on, it pastes the initial value fine (2,7), but then it continually pastes (in an endless loop) the first row/column and doesn't seem to increment/offset through the values, i.e. The expectation is:

    (2,7) Initial Value
    (3,7) Next Value
    (4,7) Next Value
    (5,7) Next Value
    (6,7) Next Value etc etc until empty
    
    Set objExcel = CreateObject("Excel.Application")
    Set objWb = objExcel.Workbooks.Open("C:\test.xlsx")
    Set objSheet = objWb.Worksheets("sheet1")
    
    Set initialVal = objSheet.Cells(2, 7)
    
    'At this point code (TBC, not required to highlight this issue) will paste the
    'initialVal to a text field in the GUI and subsequently clear/delete the field
    
    Sub test1()
        Set nextVal = ObjExcel.ActiveCell
    
        Do Until IsEmpty(nextVal)
            nextVal.Offset(1, 0).Select
            'Again, at this point the code will paste the nextVal to the GUI (and
            'subsequently clear it) , loop back and move down one cell and paste that
            'next cell until it hits an empty cell and come out of the loop
        Loop
    End Sub
    
    Call test1
    
    • Gurmanjot Singh
      Gurmanjot Singh over 6 years
      Did the solution work?
    • CodeSpy
      CodeSpy over 6 years
      Hi. This worked a treat yes.....Thanks for the help
  • Gurmanjot Singh
    Gurmanjot Singh over 6 years
    If this is the answer you wanted, you can select it as answer