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

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

CodePudding user response：

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

CodePudding user response：

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