VBA and looping

W

wigarth

Board Regular
Joined
Apr 16, 2016
Messages
51
Office Version
  1. 365
Platform
  1. Windows
Hi!

I have little experience with loop functions, so I am looking for a bit of help.

I have provided a 2 part code that works fine, but the problem is that for each part of the code, I will need to change some row numbers.
I was simply wondering if i could loop the code somehow with defining a row number that increases for each run in the loop? If not i will need to make 45 parts of the same code...

The code will need to loop from the value 6 to 58
And of course, to make it complicated... The row numbers: 21-24 and 40-43 are to be skipped...

I am sure this can be done somehow, but i am not skilled enough yet to do so.
Can someone please help?

Best reggards:
Wigarth

VBA Code: 
'Code in 45 parts!!!... (Each "PART" has a designated row-number spanning from "6" to "58" in the columns "S" and "T"
'BUT: IMPORTANT!!! ROW/COLUMN (S21:T24) & (S40:T43) are supposed to be skipped somehow

'part 1 of code

AREA1_TRIP1: 'rownumber here is "6"
If ThisWorkbook.Sheets("Epost").Range("f6").Value = "" Then ' "F".value -changes in next part
GoTo AREA1_TRIP2
Else
End If

'"T".value below changes in next part
beskjed.beskjedtekst.Caption = " - Creating data for: " & ThisWorkbook.Sheets("Epost").Range("t6").Value
.Repaint

'Both "S".values below changes in next part
If ThisWorkbook.Sheets(ThisWorkbook.Sheets("Epost").Range("S6").Value).Range("y2").Value = 1 Then
ThisWorkbook.Sheets(ThisWorkbook.Sheets("Epost").Range("S6").Value).Range("A1:K34").ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Sheets("Feilretting").Range("c20").Value & "Tur1-Rute1.pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
GoTo AREA1_TRIP2
Else
End If

'Both "S".values below changes in next part
If ThisWorkbook.Sheets(ThisWorkbook.Sheets("Epost").Range("S6").Value).Range("y2").Value = 2 Then
ThisWorkbook.Sheets(ThisWorkbook.Sheets("Epost").Range("S6").Value).Range("A1:K70").ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Sheets("Feilretting").Range("c20").Value & "Tur1-Rute1.pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
GoTo AREA1_TRIP2
Else
End If

'Both "S".values below changes in next part
If ThisWorkbook.Sheets(ThisWorkbook.Sheets("Epost").Range("S6").Value).Range("y2").Value = 3 Then
ThisWorkbook.Sheets(ThisWorkbook.Sheets("Epost").Range("S6").Value).Range("A1:K105").ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Sheets("Feilretting").Range("c20").Value & "Tur1-Rute1.pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
GoTo AREA1_TRIP2
Else
End If

'The "S".value below changes in next part
ThisWorkbook.Sheets(ThisWorkbook.Sheets("Epost").Range("S6").Value).Range("A1:K140").ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Sheets("Feilretting").Range("c20").Value & "Tur1-Rute1.pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
'End of part 1


'PART 2 of code

AREA1_TRIP2: 'rownumber here is "7"
If ThisWorkbook.Sheets("Epost").Range("f7").Value = "" Then ' "F".value -changes in next part
GoTo AREA1_TRIP3
Else
End If

'"T".value below changes in next part
beskjed.beskjedtekst.Caption = " - Creating data for: " & ThisWorkbook.Sheets("Epost").Range("t7").Value
.Repaint

'Both "S".values below changes in next part
If ThisWorkbook.Sheets(ThisWorkbook.Sheets("Epost").Range("S7").Value).Range("y2").Value = 1 Then
ThisWorkbook.Sheets(ThisWorkbook.Sheets("Epost").Range("S7").Value).Range("A1:K34").ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Sheets("Feilretting").Range("c20").Value & "Tur1-Rute2.pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
GoTo AREA1_TRIP3
Else
End If

'Both "S".values below changes in next part
If ThisWorkbook.Sheets(ThisWorkbook.Sheets("Epost").Range("S7").Value).Range("y2").Value = 2 Then
ThisWorkbook.Sheets(ThisWorkbook.Sheets("Epost").Range("S7").Value).Range("A1:K70").ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Sheets("Feilretting").Range("c20").Value & "Tur1-Rute2.pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
GoTo AREA1_TRIP3
Else
End If

'Both "S".values below changes in next part
If ThisWorkbook.Sheets(ThisWorkbook.Sheets("Epost").Range("S7").Value).Range("y2").Value = 3 Then
ThisWorkbook.Sheets(ThisWorkbook.Sheets("Epost").Range("S7").Value).Range("A1:K105").ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Sheets("Feilretting").Range("c20").Value & "Tur1-Rute2.pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
GoTo AREA1_TRIP3
Else
End If

'The "S".value below changes in next part
ThisWorkbook.Sheets(ThisWorkbook.Sheets("Epost").Range("S7").Value).Range("A1:K140").ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Sheets("Feilretting").Range("c20").Value & "Tur1-Rute2.pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
'End of part 2
 
Last edited:

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.
Sort by date Sort by votes
You could try something along this line:

VBA Code: 
Private Sub test2()
Dim i As Integer

For i = 6 To 58
    If i > 20 And i < 25 Then GoTo SkipThisOne
    If i > 39 And i < 44 Then GoTo SkipThisOne
    
    'your code goes here

SkipThisOne:
Next
End Sub
 
Upvote 0
Hi!

Thanks for helping. I think we are close, but so far It doesnt work.... it makes the first pdf, but i get an error 5... Do I need to state somehow that "next" =i+1? (If that makes any sense?)
Here is the code i got so far....

VBA Code: 
Sub testpdf()
'Lager pdf av mankoliste
'Application.ScreenUpdating = False
beskjed.Show vbModeless
With beskjed

'(MANGLER)slå på utregning av alle faner i mankolistene

Dim i As Integer

For i = 6 To 58
    If i > 20 And i < 25 Then GoTo SkipThisOne
    If i > 39 And i < 44 Then GoTo SkipThisOne
    
    'your code goes here

If ThisWorkbook.Sheets("Epost").Range("f" & i).Value = "" Then
GoTo SkipThisOne
Else
End If

beskjed.beskjedtekst.Caption = " - Opretter mankolister til sjåfør for Rute:" & ThisWorkbook.Sheets("Epost").Range("t" & i).Value
.Repaint

'hvis 1 side
If ThisWorkbook.Sheets(ThisWorkbook.Sheets("Epost").Range("S" & i).Value).Range("y2").Value = 1 Then
ThisWorkbook.Sheets(ThisWorkbook.Sheets("Epost").Range("S" & i).Value).Range("A1:K34").ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Sheets("Feilretting").Range("c20").Value & ThisWorkbook.Sheets("Epost").Range("S" & i).Value & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
GoTo SkipThisOne
Else
End If

'hvis 2 sider
If ThisWorkbook.Sheets(ThisWorkbook.Sheets("Epost").Range("S" & i).Value).Range("y2").Value = 2 Then
ThisWorkbook.Sheets(ThisWorkbook.Sheets("Epost").Range("S" & i).Value).Range("A1:K70").ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Sheets("Feilretting").Range("c20").Value & ThisWorkbook.Sheets("Epost").Range("S" & i).Value & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
GoTo SkipThisOne
Else
End If

'hvis 3 sider
If ThisWorkbook.Sheets(ThisWorkbook.Sheets("Epost").Range("S" & i).Value).Range("y2").Value = 3 Then
ThisWorkbook.Sheets(ThisWorkbook.Sheets("Epost").Range("S" & i).Value).Range("A1:K105").ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Sheets("Feilretting").Range("c20").Value & ThisWorkbook.Sheets("Epost").Range("S" & i).Value & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
GoTo SkipThisOne
Else
End If

'hvis 4 sider
ThisWorkbook.Sheets(ThisWorkbook.Sheets("Epost").Range("S" & i).Value).Range("A1:K140").ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Sheets("Feilretting").Range("c20").Value & ThisWorkbook.Sheets("Epost").Range("S" & i).Value & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False


SkipThisOne:
Next
'(MANGLER)slå av kalk på alle mankolistene
beskjed.Hide
End With
End Sub
 
Upvote 0
I just noticed you have a 'goto skipthisone' with every section of code. That should not be required. that is only required where I indicated in my initial post
 
Upvote 0
I tried using "Next" instead... still get the error.
It fails at line 27 (counting the blank lines as well)
But it makes the pdf at the right location and with the correct file name and with the right content inside the pdf.

Here is the updated code:
VBA Code: 
Sub testpdf()
'Lager pdf av mankoliste
'Application.ScreenUpdating = False
beskjed.Show vbModeless
With beskjed

'(MANGLER)slå på utregning av alle faner i mankolistene

Dim i As Integer

For i = 6 To 58
    If i > 20 And i < 25 Then GoTo SkipThisOne
    If i > 39 And i < 44 Then GoTo SkipThisOne
    
    'your code goes here

If ThisWorkbook.Sheets("Epost").Range("f" & i).Value = "" Then
GoTo SkipThisOne
Else
End If

beskjed.beskjedtekst.Caption = " - Opretter mankolister til sjåfør for Rute:" & ThisWorkbook.Sheets("Epost").Range("t" & i).Value
.Repaint

'hvis 1 side
If ThisWorkbook.Sheets(ThisWorkbook.Sheets("Epost").Range("S" & i).Value).Range("y2").Value = 1 Then
ThisWorkbook.Sheets(ThisWorkbook.Sheets("Epost").Range("S" & i).Value).Range("A1:K34").ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Sheets("Feilretting").Range("c20").Value & ThisWorkbook.Sheets("Epost").Range("S" & i).Value & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Else
End If

'hvis 2 sider
If ThisWorkbook.Sheets(ThisWorkbook.Sheets("Epost").Range("S" & i).Value).Range("y2").Value = 2 Then
ThisWorkbook.Sheets(ThisWorkbook.Sheets("Epost").Range("S" & i).Value).Range("A1:K70").ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Sheets("Feilretting").Range("c20").Value & ThisWorkbook.Sheets("Epost").Range("S" & i).Value & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Else
End If

'hvis 3 sider
If ThisWorkbook.Sheets(ThisWorkbook.Sheets("Epost").Range("S" & i).Value).Range("y2").Value = 3 Then
ThisWorkbook.Sheets(ThisWorkbook.Sheets("Epost").Range("S" & i).Value).Range("A1:K105").ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Sheets("Feilretting").Range("c20").Value & ThisWorkbook.Sheets("Epost").Range("S" & i).Value & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Else
End If

'hvis 4 sider
If ThisWorkbook.Sheets(ThisWorkbook.Sheets("Epost").Range("S" & i).Value).Range("y2").Value = 4 Then
ThisWorkbook.Sheets(ThisWorkbook.Sheets("Epost").Range("S" & i).Value).Range("A1:K140").ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Sheets("Feilretting").Range("c20").Value & ThisWorkbook.Sheets("Epost").Range("S" & i).Value & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Else
End If

SkipThisOne:
Next
'(MANGLER)slå av kalk på alle mankolistene
beskjed.Hide
End With
End Sub
 
Upvote 0
Try this:

VBA Code: 
Sub testpdf()
'Lager pdf av mankoliste
'Application.ScreenUpdating = False
beskjed.Show vbModeless
With beskjed

'(MANGLER)slå på utregning av alle faner i mankolistene

Dim i As Integer

For i = 6 To 58
    If i > 20 And i < 25 Then GoTo SkipThisOne
    If i > 39 And i < 44 Then GoTo SkipThisOne
    
    'your code goes here

If ThisWorkbook.Sheets("Epost").Range("f" & i).Value = "" Then
GoTo SkipThisOne
Else
End If

beskjed.beskjedtekst.Caption = " - Opretter mankolister til sjåfør for Rute:" & ThisWorkbook.Sheets("Epost").Range("t" & i).Value
.Repaint

'hvis 1 side
If ThisWorkbook.Sheets(ThisWorkbook.Sheets("Epost").Range("S" & i).Value).Range("y2").Value = 1 Then
ThisWorkbook.Sheets(ThisWorkbook.Sheets("Epost").Range("S" & i).Value).Range("A1:K34").ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Sheets("Feilretting").Range("c20").Value & ThisWorkbook.Sheets("Epost").Range("S" & i).Value & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Else
End If

'hvis 2 sider
If ThisWorkbook.Sheets(ThisWorkbook.Sheets("Epost").Range("S" & i).Value).Range("y2").Value = 2 Then
ThisWorkbook.Sheets(ThisWorkbook.Sheets("Epost").Range("S" & i).Value).Range("A1:K70").ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Sheets("Feilretting").Range("c20").Value & ThisWorkbook.Sheets("Epost").Range("S" & i).Value & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Else
End If

'hvis 3 sider
If ThisWorkbook.Sheets(ThisWorkbook.Sheets("Epost").Range("S" & i).Value).Range("y2").Value = 3 Then
ThisWorkbook.Sheets(ThisWorkbook.Sheets("Epost").Range("S" & i).Value).Range("A1:K105").ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Sheets("Feilretting").Range("c20").Value & ThisWorkbook.Sheets("Epost").Range("S" & i).Value & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Else
End If

'hvis 4 sider
If ThisWorkbook.Sheets(ThisWorkbook.Sheets("Epost").Range("S" & i).Value).Range("y2").Value = 4 Then
ThisWorkbook.Sheets(ThisWorkbook.Sheets("Epost").Range("S" & i).Value).Range("A1:K140").ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Sheets("Feilretting").Range("c20").Value & ThisWorkbook.Sheets("Epost").Range("S" & i).Value & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Else
End If

SkipThisOne:
Next
'(MANGLER)slå av kalk på alle mankolistene

End With
beskjed.Hide

End Sub
 
Upvote 0
Same error occurs... BTW. I can't see any change in the code?
Code executes fine until it reaches "next" ...
Row 6 goes fine, 7 crashes... i have verified that refrences are correct with sheet names etc
Also tried to update the numbers that it starts with 7... then it chrashes on 8
 
Upvote 0
Or, with select case:

PHP: 
For i = 6 to 58
    Select Case i
          Case 21,22,23,24,40,41,42,43
                ' Do nothing
          Case Else
              <Your main code here>
     End select
Next
 
Upvote 1
I am with @bebo021999 in favouring using the select statement.
I can't test your form lines of code but see if this helps at all.

Rich (BB code): 
Sub testpdf()
'Lager pdf av mankoliste
'(MANGLER)slå på utregning av alle faner i mankolistene

'Application.ScreenUpdating = False
Dim i As Integer
Dim wbThis As Workbook
Dim shtEPost As Worksheet, shtToPDF As Worksheet
Dim sShtName As String
Dim lPages As Long
Dim rowEnd As Long

Set wbThis = ThisWorkbook
Set shtEPost = wbThis.Worksheets("Epost")

beskjed.Show vbModeless

For i = 6 To 58
    Select Case i
        Case 21, 22, 23, 24, 40, 41, 42, 43
            ' Do nothing
        Case Else
            
            If shtEPost.Range("f" & i).Value <> "" Then
                beskjed.beskjedtekst.Caption = " - Opretter mankolister til sjåfør for Rute:" & shtEPost.Range("t" & i).Value
                beskjed.Repaint
               
                sShtName = shtEPost.Range("S" & i).Value
           
                Set shtToPDF = wbThis.Worksheets(sShtName)
                lPages = shtToPDF.Range("y2").Value
               
                Select Case lPages
                    Case 1              'hvis 1 side
                        rowEnd = 34
                    Case 2              'hvis 2 side
                        rowEnd = 70
                    Case 3              'hvis 3 side
                        rowEnd = 105
                    Case 4              'hvis 4 side
                        rowEnd = 140
                    Case Else
                        rowEnd = 0
                End Select
               
                If rowEnd <> 0 Then
                    shtToPDF.Range("A1:K" & rowEnd).ExportAsFixedFormat Type:=xlTypePDF, _
                        Filename:=wbThis.Sheets("Feilretting").Range("c20").Value & sShtName & ".pdf", _
                        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
                        OpenAfterPublish:=False
                End If
            End If
        End Select
Next i

beskjed.Hide

'Application.ScreenUpdating = True
End Sub
 
Upvote 0
Solution
You must log in or register to reply here.

Similar threads

J
  • Locked
  • Question
Export to PDF bug
Replies
1
Views
104
Joe4
Joe4
J
  • Question
ExportAsFixedFormat Bug
Replies
2
Views
146
Joepa
J
J
  • Question
SAVING A PDF SPREADSHEET IN EXCEL DOESN'T WORK
Replies
1
Views
364
dmt32
D
G
  • Question
Amend VBA
Replies
9
Views
112
hrayani
H
S
  • Question
Save several sheets of the workbook in one sheet in PDF format
Replies
2
Views
218
sofas
S

Forum statistics

Threads
1,214,973
Messages
6,122,534
Members
449,088
Latest member
RandomExceller01

Share this page

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