Need help to create a double loop ?

fredrerik84

Active Member
Joined
Feb 26, 2017
Messages
383
Hi Im working on pulling some information from a web page , unfortunately it was not so straightforward as it usually is. But I found a solution to get it to be correctly displayed in excel. here is my working code.

Code:
        i = 3
        On Error Resume Next
        str = HTMLRows(i).innerText
        If InStr(str, "eller") = 0 Then
           For x = 2 To 200
              If Trim(Split(HTMLRows(i).innerText, vbCrLf)(x)) <> "" Then
                 str = Trim(Split(HTMLRows(i).innerText, vbCrLf)(x))
                 If InStr(str, "+") = 0 Then
                    If s = 1 Then
                       yy = 7
                    ElseIf s = 2 Then
                       yy = 1
                    ElseIf s = 3 Then
                       yy = 6
                    ElseIf s = 4 Then
                       yy = 0
                    ElseIf s = 5 Then
                       yy = 5
                    ElseIf s = 6 Then
                       yy = -1
                    End If
                    Cells(j, y + yy).value = str
                    y = y + 1
                    s = s + 1
                    If s = 7 Then
                       s = 0
                       yy = 0
                    End If
                    If y = 9 Then
                       j = j + 1
                       y = 2
                    End If
                 End If
              End If
          Next x
        Else
        For x = 2 To 14
              If Trim(Split(HTMLRows(i).innerText, vbCrLf)(x)) <> "" Then
                 str = Trim(Split(HTMLRows(i).innerText, vbCrLf)(x))
                 If InStr(str, "+") = 0 Then
                    If s = 1 Then
                       yy = 7
                    ElseIf s = 2 Then
                       yy = 1
                    ElseIf s = 3 Then
                       yy = 6
                    ElseIf s = 4 Then
                       yy = 0
                    ElseIf s = 5 Then
                       yy = 5
                    ElseIf s = 6 Then
                       yy = -1
                    End If
                    Cells(j, y + yy).value = str
                    y = y + 1
                    s = s + 1
                    If s = 7 Then
                       s = 0
                       yy = 0
                    End If
                    If y = 9 Then
                       j = j + 1
                       y = 2
                    End If
                 End If
              End If
          Next x
        End If

Ive tested this manually for every "HTMLrows" by changing variable i from 0 - 50 then run the code and everything works perfect on everyrow. However trying to make a master loop for the i var was harder that i thought.

does anyone know how to make this 2nd master loop to loop trough all the html rows ?
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
well I found a workaround maybe not the most elegent , but it does work:

Code:
    i = -1
top:
        i = i + 1
        If i = 50 Then
           GoTo finished
        End If
        On Error Resume Next
        str = HTMLRows(i).innerText
        If InStr(str, "eller") = 0 Then
           For x = 2 To 200
              If Trim(Split(HTMLRows(i).innerText, vbCrLf)(x)) <> "" Then
                 str = Trim(Split(HTMLRows(i).innerText, vbCrLf)(x))
                 If InStr(str, "+") = 0 Then
                    If s = 1 Then
                       yy = 7
                    ElseIf s = 2 Then
                       yy = 1
                    ElseIf s = 3 Then
                       yy = 6
                    ElseIf s = 4 Then
                       yy = 0
                    ElseIf s = 5 Then
                       yy = 5
                    ElseIf s = 6 Then
                       yy = -1
                    End If
                    Cells(j, y + yy).value = str
                    y = y + 1
                    s = s + 1
                    If s = 7 Then
                       s = 0
                       yy = 0
                    End If
                    If y = 9 Then
                       j = j + 1
                       y = 2
                    End If
                 End If
              End If
          Next x
        Else
          For x = 2 To 14
              If Trim(Split(HTMLRows(i).innerText, vbCrLf)(x)) <> "" Then
                 str = Trim(Split(HTMLRows(i).innerText, vbCrLf)(x))
                 If InStr(str, "+") = 0 Then
                    If s = 1 Then
                       yy = 7
                    ElseIf s = 2 Then
                       yy = 1
                    ElseIf s = 3 Then
                       yy = 6
                    ElseIf s = 4 Then
                       yy = 0
                    ElseIf s = 5 Then
                       yy = 5
                    ElseIf s = 6 Then
                       yy = -1
                    End If
                    Cells(j, y + yy).value = str
                    y = y + 1
                    s = s + 1
                    If s = 7 Then
                       s = 0
                       yy = 0
                    End If
                    If y = 9 Then
                       j = j + 1
                       y = 2
                    End If
                 End If
              End If
          Next x
        End If
        GoTo top
        
finished:
 
Upvote 0
Edit: did not work my solution as it looks like my 2nd loop does not work like expected :/ any suggestions would be great ..
 
Upvote 0
Hi Fredrerik84,

Maybe i'm missing something, but would a simple FOR loop not do what you need?
Code:
For i = 1 To 50 Step 1
    'Your code in here
Next i
 
Upvote 0
its these double loops that messes me up as im not the best coder here for sure , lol

there was some problem with the code this is working as expected but maybe like you say a simple for loop for everything is better:

Code:
top:
If i = 40 Then
   GoTo finished
End If
i = i + 1
        On Error Resume Next
        str = HTMLRows(i).innerText
        If Len(HTMLRows(i).innerText) = 0 Then
           GoTo top
        End If
           For x = 2 To 200
              If Trim(Split(HTMLRows(i).innerText, vbCrLf)(x)) <> "" Then
                 str = Trim(Split(HTMLRows(i).innerText, vbCrLf)(x))
                 If InStr(str, "+") = 0 Then
                   If s = 0 Then
                       y = 2
                       If InStr(str, "I dag ") <> 0 Then
                          str = Replace(str, "I dag ", "")
                          mDate = Date
                       End If
                       If InStr(str, "I mrg ") <> 0 Then
                          mDate = Date
                          str = Replace(str, "I mrg ", "")
                       End If
                       Cells(j, "A").value = mDate
                    ElseIf s = 1 Then
                       yy = 7
                    ElseIf s = 2 Then
                       yy = 1
                       On Error Resume Next
                       str = Application.VLookup(str, sheet.Range("AC" & 2 & ":AH" & lrdata), , False)
                    ElseIf s = 3 Then
                       yy = 6
                    ElseIf s = 4 Then
                       yy = 0
                       str = Replace(str, "X", "-")
                    ElseIf s = 5 Then
                       yy = 5
                    ElseIf s = 6 Then
                       yy = -1
                    End If
                    Cells(j, y + yy).value = str
                    y = y + 1
                    s = s + 1
                    If s = 7 Then
                       s = 0
                       yy = 0
                    End If
                    If y = 9 Then
                       j = j + 1
                       y = 2
                       If InStr(HTMLRows(i).innerText, "eller") <> 0 Then
                          Exit For
                       End If
                       If InStr(HTMLRows(i).innerText, "---") <> 0 Then
                          Exit For
                       End If
                    End If
                 End If
              End If
           Next x
           GoTo top
finished:
 
Upvote 0
Hey

Yes double loops can get complicated! Glad you got it working...

I would suggest first using SELECT CASE instead of IF, ELSEIF etc. Makes the code easier to read;
Code:
Select Case s
    Case 0
        y = 2
        If InStr(Str, "I dag ") <> 0 Then
            Str = Replace(Str, "I dag ", "")
            mDate = Date
        End If
        If InStr(Str, "I mrg ") <> 0 Then
            mDate = Date
            Str = Replace(Str, "I mrg ", "")
        End If
        Cells(j, "A").Value = mDate
    
    Case 1
        yy = 7
        
    Case 2
        yy = 1
        On Error Resume Next
        Str = Application.VLookup(Str, Sheet.Range("AC" & 2 & ":AH" & lrdata), , False)
        
    Case 3
        yy = 6
                       
'and so on...

Cheers
Caleeco
 
Upvote 0
You are right about if then else, I'm using this far too much, but first time I hear about using case as an alternative.. I really like this, if you don't mind could you show a sample with that usage?

Best regards
 
Upvote 0
Hi,

This is UNTESTED. Without seeing the full code, or what data it is pulling I can't offer any more code improvements. But the general format of using select case is shown below.
Code:
top:
If i = 40 Then
   GoTo finished
End If
i = i + 1
On Error Resume Next
Str = HTMLRows(i).innerText
If Len(HTMLRows(i).innerText) = 0 Then
    GoTo top
End If
For x = 2 To 200
    If Trim(Split(HTMLRows(i).innerText, vbCrLf)(x)) <> "" Then
        Str = Trim(Split(HTMLRows(i).innerText, vbCrLf)(x))
        If InStr(Str, "+") = 0 Then
            Select Case s
                Case 0
                    y = 2
                    If InStr(Str, "I dag ") <> 0 Then Str = Replace(Str, "I dag ", "")
                    If InStr(Str, "I mrg ") <> 0 Then Str = Replace(Str, "I mrg ", "")
                    mDate = Date
                    Cells(j, "A").Value = mDate
                    
                Case 1
                    yy = 7
                    
                Case 2
                    yy = 1
                    On Error Resume Next
                    Str = Application.VLookup(Str, Sheet.Range("AC" & 2 & ":AH" & lrdata), , False)
                
                Case 3
                    yy = 6
                    
                Case 4
                    yy = 0
                    Str = Replace(Str, "X", "-")
                    
                Case 5
                    yy = 5
                Case 6
                    yy = -1
            End Select


            Cells(j, y + yy).Value = Str
            y = y + 1
            s = s + 1
            If s = 7 Then
                s = 0
                yy = 0
            End If
                    
            If y = 9 Then
                j = j + 1
                y = 2
                If InStr(HTMLRows(i).innerText, "eller") <> 0 Then Exit For
                If InStr(HTMLRows(i).innerText, "---") <> 0 Then Exit For
        End If
    End If
Next x
GoTo top
finished:

Also note, when you have a single statement in an IF statement like so:
Code:
If InStr(HTMLRows(i).innerText, "eller") <> 0 Then
        Exit For
End If

You can abbreviate it to a single line:
Code:
If InStr(HTMLRows(i).innerText, "eller") <> 0 Then Exit For

Hope that helps
Caleeco
 
Upvote 0
Nice thanks for all the info I learn a little more about this everyday.. :) I'll try to incorporate this into my code.

Have a nice day

Cheers
 
Upvote 0
No problem :) Let me know if the amended code throws up any errors

Cheers
 
Upvote 0

Forum statistics

Threads
1,214,943
Messages
6,122,369
Members
449,080
Latest member
Armadillos

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top