How to loop to last non-empty line in VBA?

Question

I have the following VBA code that allows me to populate fields in an Intranet site on Internet Explorer from Excel rows in my file, but now I want to know if there was a method to loop to the last row not empty without manually repeating the lines here is the code:

`Sub template()
Application.DisplayAlerts = False
Application.WindowState = xlMinimized
On Error Resume Next
Dim objApp
Dim objIE
Dim objWindow
Dim ie As Object
Dim strURL
Set ie = CreateObject("InternetExplorer.Application")
Set objApp = CreateObject("Shell.Application")
Set objIE = Nothing
 
strURL = "http://Intranet"
 
For Each objWindow In objApp.Windows
  If (InStr(objWindow.Name, "Internet Explorer")) Then
    If (objWindow.LocationURL = strURL) Then
      Set objIE = objWindow
      Exit For
    End If
  End If
Next
 
If (objIE Is Nothing) Then
  Set objIE = CreateObject("InternetExplorer.Application")
  objIE.navigate (strURL)
End If
 
With objIE
  .Visible = True
  Do While .Busy Or .readyState <> 4
  Loop
 
  Do While .document.readyState <> "complete"
  Loop
 

**the first line:**
 
.document.getelementbyID("inputND").Value = Worksheets("Feuil1").Range("A2")
.document.getelementbyID("inputND").innerText = Worksheets("Feuil1").Range("A2") 
.document.getElementsByTagName("button")(1).Click
Application.Wait Now + TimeValue("00:00:01")
.document.getelementbyID("categorisation_1").Value = Worksheets("Feuil1").Range("B2") & ": Object" '.Value = ": Object"
Application.Wait Now + TimeValue("00:00:01")
.document.getelementbyID("categorisation_2").Value = Worksheets("Feuil1").Range("D2") & ": Object"
Application.Wait Now + TimeValue("00:00:01")
.document.getelementbyID("categorisation_3").Value = Worksheets("Feuil1").Range("F2") & ": Object"
Application.Wait Now + TimeValue("00:00:01")
 
 
MsgBox "Please check before continuing", vbMsgBoxSetForeground + vbSystemModal
 
**the second line:**
 
.document.getelementbyID("link61").Click
.navigate "http://Intranet"
Application.Wait Now + TimeValue("00:00:01")
.document.getelementbyID("inputND").Value = Worksheets("Feuil1").Range("A3") 
.document.getelementbyID("inputND").innerText = Worksheets("Feuil1").Range("A3") 
.document.getElementsByTagName("button")(1).Click
Application.Wait Now + TimeValue("00:00:01")
.document.getelementbyID("categorisation_1").Value = Worksheets("Feuil1").Range("B3") & ": Object" '.Value = ": Object"
Application.Wait Now + TimeValue("00:00:01")
.document.getelementbyID("categorisation_2").Value = Worksheets("Feuil1").Range("D3") & ": Object"
Application.Wait Now + TimeValue("00:00:01")
.document.getelementbyID("categorisation_3").Value = Worksheets("Feuil1").Range("F3") & ": Object"
Application.Wait Now + TimeValue("00:00:01")
 
MsgBox "Please check before continuing", vbMsgBoxSetForeground + vbSystemModal
.document.getelementbyID("link61").Click

**the third line:**
'........................
 
End With
Application.DisplayAlerts = True
 
End Sub`

the first line: Worksheets("Feuil1").Range("A2");Worksheets("Feuil1").Range("B2");Worksheets("Feuil1").Range("D2");Worksheets("Feuil1").Range("F2")

the second line: Worksheets("Feuil1").Range("A3");Worksheets("Feuil1").Range("B3");Worksheets("Feuil1").Range("D3");Worksheets("Feuil1").Range("F3")

the third line: Worksheets("Feuil1").Range("A4");Worksheets("Feuil1").Range("B4");Worksheets("Feuil1").Range("D4");Worksheets("Feuil1").Range("F4")

and so on until the last non-empty line.

i don't want the following part of the code to repeat each time after the MsgBox i want the code to go in the second line on sheet1 and so on until the last non-empty line

    .document.getelementbyID("inputND").Value = Worksheets("Feuil1").Range("A2")
    .document.getelementbyID("inputND").innerText = Worksheets("Feuil1").Range("A2") 
    .document.getElementsByTagName("button")(1).Click
    Application.Wait Now + TimeValue("00:00:01")
    .document.getelementbyID("categorisation_1").Value = Worksheets("Feuil1").Range("B2") & ": Object" '.Value = ": Object"
    Application.Wait Now + TimeValue("00:00:01")
    .document.getelementbyID("categorisation_2").Value = Worksheets("Feuil1").Range("D2") & ": Object"
    Application.Wait Now + TimeValue("00:00:01")
    .document.getelementbyID("categorisation_3").Value = Worksheets("Feuil1").Range("F2") & ": Object"
    Application.Wait Now + TimeValue("00:00:01")
 
MsgBox "Please check before continuing", vbMsgBoxSetForeground + vbSystemModal

I hope to be clearer now but if you have any questions ask the months and thank you

Welcome to SO. There are about one million examples here on SO about looping until last non blank cell. Just do a little efort and some search like [this](https://stackoverflow.com/questions/28079935/make-this-code-loop-until-the-last-non-empty-row) or [this](https://stackoverflow.com/questions/44755606/vba-loop-until-cell-not-blank) or [this](https://stackoverflow.com/questions/68488154/loop-from-cell-i-to-last-cell-non-empty-cell) — Foxfire And Burns And Burns, Dec 28 '22 at 08:27
To find the last cell see this [THIS](https://stackoverflow.com/questions/11169445/find-last-used-cell-in-excel-vba) link. After that simply loop... — Siddharth Rout, Dec 28 '22 at 08:36

score 0 · Answer 1 · answered Dec 28 '22 at 08:25

0

You just get the last filled row with:

lastRow = Cells(Rows.Count, 1).End(xlUp).Row

And, depending on which column you want to focus, you put appropriate index: 1 - A, 2 - B, and so on, as a second parameters in Cells

answered Dec 28 '22 at 08:25

Michał Turczyn

32,028
14
47
69

score 0 · Answer 2 · answered Dec 29 '22 at 11:23

I advance a bit with the checkbox method and so I did as follows:

Sub Addcheckboxes()
Dim cell, LRow As Single
Dim chkbx As CheckBox
Dim MyLeft, MyTop, MyHeight, MyWidth As Double
 
Application.ScreenUpdating = False
LRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
 
For cell = 2 To LRow
    If Cells(cell, "A").Value <> "" Then
        MyLeft = Cells(cell, "O").Left
        MyTop = Cells(cell, "O").Top
        MyHeight = Cells(cell, "O").Height
        MyWidth = Cells(cell, "O").Width
        ActiveSheet.CheckBoxes.Add(MyLeft, MyTop, MyWidth, MyHeight).Select
        With Selection
            .Caption = ""
            .Value = xlOff
            .Display3DShading = False
        End With
    End If
Next cell
 
Application.ScreenUpdating = True
 
End Sub
 
 
Sub Template()
Application.DisplayAlerts = False
For Each chkbx In ActiveSheet.CheckBoxes
    If chkbx.Value = 1 Then
        For r = 1 To Rows.Count
            If Cells(r, 1).Top = chkbx.Top Then
Application.WindowState = xlMinimized
'On Error Resume Next
Dim objApp
Dim objIE
Dim objWindow
Dim ie As Object
Dim strURL
Set ie = CreateObject("InternetExplorer.Application")
Set objApp = CreateObject("Shell.Application")
Set objIE = Nothing
 
strURL = "http://intranet"
 
'Identify the IE window and connect.
 
For Each objWindow In objApp.Windows
  If (InStr(objWindow.Name, "Internet Explorer")) Then
    If (objWindow.LocationURL = strURL) Then
      Set objIE = objWindow
      Exit For
    End If
  End If
Next
 
If (objIE Is Nothing) Then
  Set objIE = CreateObject("InternetExplorer.Application")
  objIE.navigate (strURL)
End If
 
With objIE
  .Visible = True
  Do While .Busy Or .readyState <> 4
  Loop
 
  Do While .document.readyState <> "complete"
  Loop
 
.document.getElementById("inputND").Value = Worksheets("Sheet1").Range("A" & r)
.document.getElementById("inputND").innerText = Worksheets("Sheet1").Range("A" & r) 
.document.getElementsByTagName("button")(1).Click
Application.Wait Now + TimeValue("00:00:02")
.document.getelementsByClassName("grc-label ml-2")(0).getelementsByClassName("flag-icon fas fa-mobile-alt fa-lg ng-star-inserted")(0).Click
Application.Wait Now + TimeValue("00:00:01")
.document.getelementsByClassName("btn btn-grc-outline-mobile btn-rounded mr-1 mb-3 ladda-button")(0).Click
Application.Wait Now + TimeValue("00:00:01")
.document.querySelector(".ng-star-inserted [value='5: Object']").Selected = True
.document.getElementById("categorisation_1").Value = Worksheets("Sheet1").Range("B" & r) & ": Object" '.Value = ": Object"
Application.Wait Now + TimeValue("00:00:01")
.document.getElementById("categorisation_2").Value = Worksheets("Sheet1").Range("D" & r) & ": Object"
Application.Wait Now + TimeValue("00:00:01")
.document.getElementById("categorisation_3").Value = Worksheets("Sheet1").Range("F2" & r) & ": Object"
Application.Wait Now + TimeValue("00:00:01")
.document.getElementById("categorisation_4").Value = Worksheets("Sheet1").Range("H2" & r) & ": Object"
Application.Wait Now + TimeValue("00:00:01")
.document.getElementById("categorisation_5").Value = Worksheets("Sheet1").Range("J2" & r) & ": Object"
Application.Wait Now + TimeValue("00:00:01")
.document.getElementById("categorisation_6").Value = Worksheets("Sheet1").Range("L2" & r) & ": Object"
Application.Wait Now + TimeValue("00:00:01")
.document.getElementById("champContactClient").selectedIndex = 1
Application.Wait Now + TimeValue("00:00:01")
.document.getElementById("champVoie").Value = "0: Object"
Application.Wait Now + TimeValue("00:00:01")
.document.getElementById("champGravite").Value = "1: Object"
Application.Wait Now + TimeValue("00:00:01")
.document.getElementById("champCommentaire").Value = Worksheets("Sheet1").Range("N" & r)
Application.Wait Now + TimeValue("00:00:01")
MsgBox "Merci de vérifier avant de continuer", vbMsgBoxSetForeground + vbSystemModal
.document.getElementById("link61").Click
.navigate "http://intranet"
 
End With
 Exit For
            End If
        Next r
    End If
Next
Application.DisplayAlerts = True
 
End Sub

The first line checked works very well but for the second line not and I have the following line of code highlighted in yellow after the execution of the macro:

If chkbx.Value = 1 Then

How to loop to last non-empty line in VBA?

2 Answers2