[VBA] SaveAS wont work inside loop

S

steefq

New Member
Joined
Oct 17, 2021
Messages
24
Office Version
  1. 365
Platform
  1. Windows
Hi!

I need help with some of my coding.
I cant seem to get the saveAS function to work inside a do while loop.
It works fine outside the loop.
When its inside the loop it keeps saving the same file and wont exit the saveAS and go to the next step.

VBA Code: 
Sub test()

Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("LS")

Dim ws2 As Worksheet
Set ws2 = ThisWorkbook.Worksheets("Sheet1")

i = 2

y = 5
x = 7

Uo1 = 5
AntLas = 7
Kund1 = 1

ws2.Range("A12:AFP20").ClearContents

Do Until ws.Range("B" & i) = ""

If ws.Range("B" & i) = ws.Range("B" & i + 1) And ws.Range("A" & i) = ws.Range("A" & i + 1) Then

Cells(8, y) = ""

Cells(8, x) = ""

UO = ws.Range("A" & i)
LASS = ws.Range("B" & i)
Kund = ws.Range("E" & i)
antal2 = ws.Range("D" & i + 1)

ws2.Cells(8, Uo1) = UO
ws2.Cells(8, AntLas) = LASS
ws2.Cells(12, Kund1) = Kund
ws2.Cells(12 + 1, Kund1) = Kund2

i = i + 1

If ws.Range("B" & i) = ws.Range("B" & i + 1) Then

Kund3 = ws.Range("E" & i + 1)
ws2.Cells(12 + 2, Kund1) = Kund3



i = i + 1

End If


If ws.Range("B" & i) = ws.Range("B" & i + 1) Then

Kund4 = ws.Range("E" & i + 1)
ws2.Cells(12 + 3, Kund1) = Kund4


i = i + 1
End If


If ws.Range("B" & i) = ws.Range("B" & i + 1) Then


antal5 = ws.Range("D" & i + 1)
ws2.Cells(12 + 4, AntLas) = antal5

i = i + 1
End If


If ws.Range("B" & i) = ws.Range("B" & i + 1) Then


antal6 = ws.Range("D" & i + 1)
ws2.Cells(12 + 5, AntLas) = antal6

i = i + 1
End If



Else

Cells(8, y) = ""

Cells(8, x) = ""

UO = ws.Range("A" & i)
LASS = ws.Range("B" & i)


ws2.Cells(8, Uo1) = UO
ws2.Cells(8, AntLas) = LASS


End If

'Uo1 = Uo1 + 9
'AntLas = AntLas + 9
'Kund1 = Kund1 + 9
'i = i + 1
'y = y + 9
'x = x + 9

Call spara 


Loop



End Sub


The saveAS funcion is in Sub "Spara" wich im calling above the loop

This is the saveAS sub

VBA Code: 
Vecka = Range("B8").Value
UO = Range("E8").Value
LASS = Range("G8").Value

Set wb = Workbooks.Add


    ThisWorkbook.Activate
    ActiveSheet.Copy Before:=wb.Sheets(1)
    wb.Activate
    wb.SaveAs "c:\users\name\folder\" & Vecka & "-" & UO & "-" & LASS & "-" & Format(Date, "yyyymmdd") & ".xlsx"
    wb.Close
 

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
Sort by date Sort by votes
Hi, i cant seem to edit the post.

This is the "error" im getting.

1634501864828.png


Even though i click yes 100 hundred times it keeps popping up as if its not getting to the next step in the loop.
 
Upvote 0
Hi and welcome to MrExcel.

In these lines of code you are not putting the reference of the sheet.
You must put ws or ws2, as appropriate.

Rich (BB code): 
Sub test()
  Dim ws As Worksheet
  Dim ws2 As Worksheet
  Dim i As Long, y As Long, x As Long
  Dim Uo1 As Long, AntLas As Long, Kund1 As Long
  
  'Add these lines:
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False

  Set ws = ThisWorkbook.Worksheets("LS")
  Set ws2 = ThisWorkbook.Worksheets("Sheet1")
  i = 2
  y = 5
  x = 7
  Uo1 = 5
  AntLas = 7
  Kund1 = 1
  ws2.Range("A12:AFP20").ClearContents
  Do Until ws.Range("B" & i) = ""
    If ws.Range("B" & i) = ws.Range("B" & i + 1) And ws.Range("A" & i) = ws.Range("A" & i + 1) Then
      Cells(8, y) = ""
      Cells(8, x) = ""
      UO = ws.Range("A" & i)
      LASS = ws.Range("B" & i)
      Kund = ws.Range("E" & i)
      antal2 = ws.Range("D" & i + 1)
      ws2.Cells(8, Uo1) = UO
      ws2.Cells(8, AntLas) = LASS
      ws2.Cells(12, Kund1) = Kund
      ws2.Cells(12 + 1, Kund1) = Kund2
      i = i + 1
      If ws.Range("B" & i) = ws.Range("B" & i + 1) Then
        Kund3 = ws.Range("E" & i + 1)
        ws2.Cells(12 + 2, Kund1) = Kund3
        i = i + 1
      End If
      If ws.Range("B" & i) = ws.Range("B" & i + 1) Then
        Kund4 = ws.Range("E" & i + 1)
        ws2.Cells(12 + 3, Kund1) = Kund4
        i = i + 1
      End If
      If ws.Range("B" & i) = ws.Range("B" & i + 1) Then
        antal5 = ws.Range("D" & i + 1)
        ws2.Cells(12 + 4, AntLas) = antal5
        i = i + 1
      End If
      If ws.Range("B" & i) = ws.Range("B" & i + 1) Then
        antal6 = ws.Range("D" & i + 1)
        ws2.Cells(12 + 5, AntLas) = antal6
        i = i + 1
      End If
    Else
      Cells(8, y) = ""
      Cells(8, x) = ""
      UO = ws.Range("A" & i)
      LASS = ws.Range("B" & i)
      ws2.Cells(8, Uo1) = UO
      ws2.Cells(8, AntLas) = LASS
    End If
    
    'Uo1 = Uo1 + 9
    'AntLas = AntLas + 9
    'Kund1 = Kund1 + 9
    'i = i + 1
    'y = y + 9
    'x = x + 9
    
    Call spara
  Loop
End Sub

Sub spara()
  Vecka = Range("B8").Value
  UO = Range("E8").Value
  LASS = Range("G8").Value
  Set wb = Workbooks.Add
  ThisWorkbook.Activate
  ActiveSheet.Copy Before:=wb.Sheets(1)
  wb.Activate
  wb.SaveAs "c:\users\name\folder\" & Vecka & "-" & UO & "-" & LASS & "-" & Format(Date, "yyyymmdd") & ".xlsx"
  wb.Close
End Sub
 
Upvote 0
DanteAmor said:
Hi and welcome to MrExcel.

In these lines of code you are not putting the reference of the sheet.
You must put ws or ws2, as appropriate.

Rich (BB code): 
Sub test()
  Dim ws As Worksheet
  Dim ws2 As Worksheet
  Dim i As Long, y As Long, x As Long
  Dim Uo1 As Long, AntLas As Long, Kund1 As Long
 
  'Add these lines:
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False

  Set ws = ThisWorkbook.Worksheets("LS")
  Set ws2 = ThisWorkbook.Worksheets("Sheet1")
  i = 2
  y = 5
  x = 7
  Uo1 = 5
  AntLas = 7
  Kund1 = 1
  ws2.Range("A12:AFP20").ClearContents
  Do Until ws.Range("B" & i) = ""
    If ws.Range("B" & i) = ws.Range("B" & i + 1) And ws.Range("A" & i) = ws.Range("A" & i + 1) Then
      Cells(8, y) = ""
      Cells(8, x) = ""
      UO = ws.Range("A" & i)
      LASS = ws.Range("B" & i)
      Kund = ws.Range("E" & i)
      antal2 = ws.Range("D" & i + 1)
      ws2.Cells(8, Uo1) = UO
      ws2.Cells(8, AntLas) = LASS
      ws2.Cells(12, Kund1) = Kund
      ws2.Cells(12 + 1, Kund1) = Kund2
      i = i + 1
      If ws.Range("B" & i) = ws.Range("B" & i + 1) Then
        Kund3 = ws.Range("E" & i + 1)
        ws2.Cells(12 + 2, Kund1) = Kund3
        i = i + 1
      End If
      If ws.Range("B" & i) = ws.Range("B" & i + 1) Then
        Kund4 = ws.Range("E" & i + 1)
        ws2.Cells(12 + 3, Kund1) = Kund4
        i = i + 1
      End If
      If ws.Range("B" & i) = ws.Range("B" & i + 1) Then
        antal5 = ws.Range("D" & i + 1)
        ws2.Cells(12 + 4, AntLas) = antal5
        i = i + 1
      End If
      If ws.Range("B" & i) = ws.Range("B" & i + 1) Then
        antal6 = ws.Range("D" & i + 1)
        ws2.Cells(12 + 5, AntLas) = antal6
        i = i + 1
      End If
    Else
      Cells(8, y) = ""
      Cells(8, x) = ""
      UO = ws.Range("A" & i)
      LASS = ws.Range("B" & i)
      ws2.Cells(8, Uo1) = UO
      ws2.Cells(8, AntLas) = LASS
    End If
   
    'Uo1 = Uo1 + 9
    'AntLas = AntLas + 9
    'Kund1 = Kund1 + 9
    'i = i + 1
    'y = y + 9
    'x = x + 9
   
    Call spara
  Loop
End Sub

Sub spara()
  Vecka = Range("B8").Value
  UO = Range("E8").Value
  LASS = Range("G8").Value
  Set wb = Workbooks.Add
  ThisWorkbook.Activate
  ActiveSheet.Copy Before:=wb.Sheets(1)
  wb.Activate
  wb.SaveAs "c:\users\name\folder\" & Vecka & "-" & UO & "-" & LASS & "-" & Format(Date, "yyyymmdd") & ".xlsx"
  wb.Close
End Sub
Click to expand...


Hi again, thanks for a quick reply.

I made some edits as you wanted in my code and thanks for that. But the problem keeps occuring and it keeps looping and wont exit the sub "Spara" it keeps looping and saving the sheet infinity.
It saves it one time and everything looks fine in the new workbook, but it keeps saving and saving and wont exit the loop.
 
Upvote 0
Need to increase i.
I made other adjustments to run the sub.

Recommendation, you should use the "Option Explicit" statement at the beginning of all the code, that will force you to declare all your variables, that way, it will minimize the error when using them.

Rich (BB code): 
Option Explicit

Sub test()
  Dim ws As Worksheet
  Dim ws2 As Worksheet
  Dim i As Long, y As Long, x As Long
  Dim Uo1 As Long, AntLas As Long, Kund1 As Long
  Dim UO, LASS, Kund, antal2, antal5, antal6, Kund2, Kund3, Kund4
  
  'Add these lines:
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False

  Set ws = ThisWorkbook.Worksheets("LS")
  Set ws2 = ThisWorkbook.Worksheets("Sheet1")
  i = 2
  y = 5
  x = 7
  Uo1 = 5
  AntLas = 7
  Kund1 = 1
  ws2.Range("A12:AFP20").ClearContents
  Do Until ws.Range("B" & i) = ""
    If ws.Range("B" & i) = ws.Range("B" & i + 1) And ws.Range("A" & i) = ws.Range("A" & i + 1) Then
      ws2.Cells(8, y) = ""
      ws2.Cells(8, x) = ""
      UO = ws.Range("A" & i)
      LASS = ws.Range("B" & i)
      Kund = ws.Range("E" & i)
      antal2 = ws.Range("D" & i + 1)
      ws2.Cells(8, Uo1) = UO
      ws2.Cells(8, AntLas) = LASS
      ws2.Cells(12, Kund1) = Kund
      ws2.Cells(12 + 1, Kund1) = Kund2
      i = i + 1
      If ws.Range("B" & i) = ws.Range("B" & i + 1) Then
        Kund3 = ws.Range("E" & i + 1)
        ws2.Cells(12 + 2, Kund1) = Kund3
        i = i + 1
      End If
      If ws.Range("B" & i) = ws.Range("B" & i + 1) Then
        Kund4 = ws.Range("E" & i + 1)
        ws2.Cells(12 + 3, Kund1) = Kund4
        i = i + 1
      End If
      If ws.Range("B" & i) = ws.Range("B" & i + 1) Then
        antal5 = ws.Range("D" & i + 1)
        ws2.Cells(12 + 4, AntLas) = antal5
        i = i + 1
      End If
      If ws.Range("B" & i) = ws.Range("B" & i + 1) Then
        antal6 = ws.Range("D" & i + 1)
        ws2.Cells(12 + 5, AntLas) = antal6
        i = i + 1
      End If
    Else
      ws2.Cells(8, y) = ""
      ws2.Cells(8, x) = ""
      UO = ws.Range("A" & i)
      LASS = ws.Range("B" & i)
      ws2.Cells(8, Uo1) = UO
      ws2.Cells(8, AntLas) = LASS
      i = i + 1
    End If
    
    'Uo1 = Uo1 + 9
    'AntLas = AntLas + 9
    'Kund1 = Kund1 + 9
    'i = i + 1
    'y = y + 9
    'x = x + 9
    
    Call spara(ws2)
  Loop
End Sub

Sub spara(ws2)
  Dim Vecka, UO, LASS
  Dim wb As Workbook
  
  Vecka = ws2.Range("B8").Value
  UO = ws2.Range("E8").Value
  LASS = ws2.Range("G8").Value
  Set wb = Workbooks.Add
  ThisWorkbook.Activate
  ActiveSheet.Copy Before:=wb.Sheets(1)
  wb.Activate
  wb.SaveAs "c:\users\name\folder\" & Vecka & "-" & UO & "-" & LASS & "-" & Format(Date, "yyyymmdd") & ".xlsx"
  wb.Close
End Sub
Rich (BB code):
 
Upvote 0
Solution
DanteAmor said:
Need to increase i.
I made other adjustments to run the sub.

Recommendation, you should use the "Option Explicit" statement at the beginning of all the code, that will force you to declare all your variables, that way, it will minimize the error when using them.

Rich (BB code): 
Option Explicit

Sub test()
  Dim ws As Worksheet
  Dim ws2 As Worksheet
  Dim i As Long, y As Long, x As Long
  Dim Uo1 As Long, AntLas As Long, Kund1 As Long
  Dim UO, LASS, Kund, antal2, antal5, antal6, Kund2, Kund3, Kund4
 
  'Add these lines:
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False

  Set ws = ThisWorkbook.Worksheets("LS")
  Set ws2 = ThisWorkbook.Worksheets("Sheet1")
  i = 2
  y = 5
  x = 7
  Uo1 = 5
  AntLas = 7
  Kund1 = 1
  ws2.Range("A12:AFP20").ClearContents
  Do Until ws.Range("B" & i) = ""
    If ws.Range("B" & i) = ws.Range("B" & i + 1) And ws.Range("A" & i) = ws.Range("A" & i + 1) Then
      ws2.Cells(8, y) = ""
      ws2.Cells(8, x) = ""
      UO = ws.Range("A" & i)
      LASS = ws.Range("B" & i)
      Kund = ws.Range("E" & i)
      antal2 = ws.Range("D" & i + 1)
      ws2.Cells(8, Uo1) = UO
      ws2.Cells(8, AntLas) = LASS
      ws2.Cells(12, Kund1) = Kund
      ws2.Cells(12 + 1, Kund1) = Kund2
      i = i + 1
      If ws.Range("B" & i) = ws.Range("B" & i + 1) Then
        Kund3 = ws.Range("E" & i + 1)
        ws2.Cells(12 + 2, Kund1) = Kund3
        i = i + 1
      End If
      If ws.Range("B" & i) = ws.Range("B" & i + 1) Then
        Kund4 = ws.Range("E" & i + 1)
        ws2.Cells(12 + 3, Kund1) = Kund4
        i = i + 1
      End If
      If ws.Range("B" & i) = ws.Range("B" & i + 1) Then
        antal5 = ws.Range("D" & i + 1)
        ws2.Cells(12 + 4, AntLas) = antal5
        i = i + 1
      End If
      If ws.Range("B" & i) = ws.Range("B" & i + 1) Then
        antal6 = ws.Range("D" & i + 1)
        ws2.Cells(12 + 5, AntLas) = antal6
        i = i + 1
      End If
    Else
      ws2.Cells(8, y) = ""
      ws2.Cells(8, x) = ""
      UO = ws.Range("A" & i)
      LASS = ws.Range("B" & i)
      ws2.Cells(8, Uo1) = UO
      ws2.Cells(8, AntLas) = LASS
      i = i + 1
    End If
   
    'Uo1 = Uo1 + 9
    'AntLas = AntLas + 9
    'Kund1 = Kund1 + 9
    'i = i + 1
    'y = y + 9
    'x = x + 9
   
    Call spara(ws2)
  Loop
End Sub

Sub spara(ws2)
  Dim Vecka, UO, LASS
  Dim wb As Workbook
 
  Vecka = ws2.Range("B8").Value
  UO = ws2.Range("E8").Value
  LASS = ws2.Range("G8").Value
  Set wb = Workbooks.Add
  ThisWorkbook.Activate
  ActiveSheet.Copy Before:=wb.Sheets(1)
  wb.Activate
  wb.SaveAs "c:\users\name\folder\" & Vecka & "-" & UO & "-" & LASS & "-" & Format(Date, "yyyymmdd") & ".xlsx"
  wb.Close
End Sub
Rich (BB code):
Click to expand...
It works like a charm, thanks for everything.

Can you explain more what the problem was? I know that i didnt increase the I but that was because i was testing.
I didnt run the code only jumping with F8 and i thought I wouldnt matter because it should jump back to the loop after saving one file.
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Solved
Select Case in VBA
Replies
3
Views
755
rollis13
rollis13
A
  • Question Question
VBA Highlight cell if contains specific text
Replies
4
Views
2K
DanteAmor
DanteAmor
I
  • Question Question
Copy column value but skip over to next column if empty
Replies
0
Views
428
inwonderland7
I
K
  • Question Question
VBA : Copy only new information from specific cells in another worksheet
Replies
6
Views
901
kevin9999
K
Drrellik
  • Solved
VBA to complete Index/Match with 2 criteria
2
Replies
10
Views
476
Alex Blakenburg
A

Forum statistics

Threads
1,224,823
Messages
6,181,176
Members
453,021
Latest member
Justyna P

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