# VBA Help using loop



## Aviator08 (Jan 5, 2023)

Hello,

I am trying to write a code where it copies a number from a provided list, pastes the number in a cell, calculates to update, then saves that tab in a folder and breaks the links before saving the file. The macro repeats this process till there are no more numbers to copy. I am having issues on the saving portion of the macro. I added a step to copy the tab in a new book, break links and then save the file. 

The first issue I have when it saves, is that it saves it as an XPS file. The second issue is that the loop fails and I get a Debug error. I am no where near familiar with VBA, i used some old coding from another macro and trying to fit into this, so my apologies in advanced if it is horrible. Below is the code so far. Thank you.


Sub CreateStoreTargets()


Set shtTarget = Worksheets("StoreLabor")


    Do Until Sheets("VBA - Comp Store List").Range("B1") = ""
    StoreID = Sheets("VBA - Comp Store List").Range("B1").Value
    District = Sheets("VBA - Comp Store List").Range("C1").Value

    Sheets("StoreLabor").Select
    Cells.Select
    With Selection.Font
                  .ThemeColor = xlThemeColorLight1
                  .TintAndShade = 0
    End With
    Range("A2").Select
    Sheets("VBA - Comp Store List").Select
    Range("A1").Select
    Selection.Copy
    Sheets("StoreLabor").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Application.Calculate
    Sheets("VBA - Comp Store List").Select
    Range("A1:C1").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp


    Sheets("StoreLabor").Select
    Sheets("StoreLabor").Copy


 ' Define variable as an Excel link type.
 astrLinks = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)

 ' Break the first link in the active workbook.
 ActiveWorkbook.BreakLink _
 Name:=astrLinks(1), _
 Type:=xlLinkTypeExcelLinks

    ActiveSheet.ExportAsFixedFormat Type:=xlExcelLinks, Filename:=strFilePath1 & StoreID & strFilePath2 & strReportTitle1 & StoreID & strReportTitle2 & strDateFooter & strFilePath3, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

Loop

ThisWorkbook.Saved = False
Application.Quit

End Sub


----------



## HaHoBe (Sunday at 6:23 AM)

Hi Aviator08,

maybe as a start


```
Public Sub MrE_1226151_170080D()
' https://www.mrexcel.com/board/threads/vba-help-using-loop.1226151/

Dim wsTarget As Worksheet
Dim wsData As Worksheet
Dim varStoreID As Variant
Dim varDistrict As Variant
Dim astrLinks As Variant

'all these componenets are mentioned but no value has been assigned to them in the code
'you would need to change the contents to suit
Const strFilePath1 As String = "C:\Result\"
Const strFilePath2 As String = "\Test\"
Const strReportTitle1 As String = "My Report "
Const strReportTitle2 As String = " Quartal 1"
Const strDateFooter As String = "20230107"
Const strFilePath3 As String = "_xx_yy_zz"

Set wsTarget = Worksheets("StoreLabor")
Set wsData = Worksheets("VBA - Comp Store List")

Do Until wsData.Range("B1") = ""
  varStoreID = wsData.Range("B1").Value
  varDistrict = wsData.Range("C1").Value
  
  With wsTarget.Cells.Font
    .ThemeColor = xlThemeColorLight1
    .TintAndShade = 0
  End With
  wsTarget.Range("A2").Value = wsData.Range("A1").Value
  Application.Calculate
  wsData.Range("A1:C1").Delete Shift:=xlUp
  
  wsTarget.Copy
  
  ' Define variable as an Excel link type.
  On Error Resume Next
  astrLinks = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)
  
  ' Break the first link in the active workbook.
  ActiveWorkbook.BreakLink _
    Name:=astrLinks(1), _
    Type:=xlLinkTypeExcelLinks
  Err.Clear
  On Error GoTo 0
  
  ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=strFilePath1 & varStoreID & strFilePath2 & strReportTitle1 & _
              varStoreID & strReportTitle2 & strDateFooter & strFilePath3, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
  ActiveWorkbook.Close False
Loop

Set wsData = Nothing
Set wsTarget = Nothing
ThisWorkbook.Saved = False
Application.Quit

End Sub
```

Ciao,
Holger


----------



## Aviator08 (Tuesday at 6:29 PM)

HaHoBe said:


> Hi Aviator08,
> 
> maybe as a start
> 
> ...



Hello,

Thank you for the help. A few things I learned and would like to change from this code. I was not aware the ExportAsFixedFormat meant it would be PDF or XPS. I would like to save the sheet that I copied ("StoreLabor") into a new workbook as an Excel worksheet (.XLSX). My other question is on how/where in the code does it close the new book after it has saved it in the path assigned and go back to the original file and continues going down the list of numbers provided? Again, thanks a lot for your help and time.


----------



## HaHoBe (Wednesday at 3:42 AM)

Hi Aviator08,

changes are commented in the code:


```
Public Sub MrE_1226151_170080D_mod()
' https://www.mrexcel.com/board/threads/vba-help-using-loop.1226151/
' Updated: 20230111
' Reason:  changed from saving as PDF to saving as macrofree workbook

Dim wsTarget As Worksheet
Dim wsData As Worksheet
Dim varStoreID As Variant
Dim varDistrict As Variant
Dim astrLinks As Variant

'all these componenets are mentioned but no value has been assigned to them in the code
'you would need to change the contents to suit
Const strFilePath1 As String = "C:\Result\"
Const strFilePath2 As String = "\Test\"
Const strReportTitle1 As String = "My Report "
Const strReportTitle2 As String = " Quartal 1"
Const strDateFooter As String = "20230107"
Const strFilePath3 As String = "_xx_yy_zz"

Set wsTarget = Worksheets("StoreLabor")
Set wsData = Worksheets("VBA - Comp Store List")

Do Until wsData.Range("B1") = ""
  varStoreID = wsData.Range("B1").Value
  varDistrict = wsData.Range("C1").Value
  
  With wsTarget.Cells.Font
    .ThemeColor = xlThemeColorLight1
    .TintAndShade = 0
  End With
  wsTarget.Range("A2").Value = wsData.Range("A1").Value
  Application.Calculate
  wsData.Range("A1:C1").Delete Shift:=xlUp
  
  wsTarget.Copy
  
  ' Define variable as an Excel link type.
  On Error Resume Next
  astrLinks = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)
  
  ' Break the first link in the active workbook.
  ActiveWorkbook.BreakLink _
    Name:=astrLinks(1), _
    Type:=xlLinkTypeExcelLinks
  Err.Clear
  On Error GoTo 0
  
  '/// assuming that there is no extension for the file added to strFilePath3
  '/// I would use another variable to combine the parts and use that variable to store as it would hold
  '/// the information about drive, folder and name/extension of the workbook in one place
  ActiveWorkbook.SaveAs Filename:=strFilePath1 & varStoreID & strFilePath2 & strReportTitle1 & _
              varStoreID & strReportTitle2 & strDateFooter & strFilePath3 & ".xlsx", FileFormat:=51 'xlOpenXMLWorkbook
  '/// next command closes new workbook without saving, last activeworkbook before gets the focus again
  ActiveWorkbook.Close False
Loop

Set wsData = Nothing
Set wsTarget = Nothing
ThisWorkbook.Saved = False
Application.Quit

End Sub
```

Holger


----------

