I am trying to use some Parsing i was able to tweak a little. If I use it in straight VBA in excel, it works fine. However, when I use the same code as a module in VB.NET I get the error in the title on the line of code
ws.Range(vTitles).AutoFilter()
(duh!) I am not sure what is going wrong in the conversion, since I am not a hardcore VB.Net programmer, so I am doing a lot of googling, but not finding much that works. Any ideas on how this could be fixed or do I have to abandon the idea of using this snippet in VB.Net?
Here is the code I am using:
'turned strict off or autofilter per http://www.pcreview.co.uk/threads/autofilter-method-of-range-class-failed.3994483/
Option Strict Off
Imports xl = Microsoft.Office.Interop.Excel
Module ParseItems
Public Sub ParseItems(ByRef fileName As String)
'Jerry Beaucaire (4/22/2010)
'Based on selected column, data is filtered to individual workbooks are named for the value plus today's date
Dim wb As xl.Workbook
Dim xlApp As xl.Application
Dim LR As Long, Itm As Long, MyCount As Long, vCol As Long
Dim ws As xl.Worksheet, MyArr As Object, vTitles As String, SvPath As String
'Set new application and make wb visible
xlApp = New xl.Application
xlApp.Visible = True
'open workbook
wb = xlApp.Workbooks.Open(fileName)
'Sheet with data in it
ws = wb.Sheets("Original Data")
'Path to save files into, remember the final "\"
SvPath = "G:\MC VBA test\"
'Range where titles are across top of data, as string, data MUST have titles in this row, edit to suit your titles locale
vTitles = "A1:L1"
'Choose column to evaluate from, column A = 1, B = 2, etc.
vCol = xlApp.InputBox("What column to split data by? " & vbLf & vbLf & "(A=1, B=2, C=3, etc)", "Which column?", 1, Type:=1)
If vCol = 0 Then Exit Sub
'Spot bottom row of data
LR = ws.Cells(ws.Rows.Count, vCol).End(xl.XlDirection.xlUp).Row
'Speed up macro execution
'Application.ScreenUpdating = False
'Get a temporary list of unique values from key column
ws.Columns(vCol).AdvancedFilter(Action:=xl.XlFilterAction.xlFilterCopy, CopyToRange:=ws.Range("EE1"), Unique:=True)
'Sort the temporary list
ws.Columns("EE:EE").Sort(Key1:=ws.Range("EE2"), Order1:=xl.XlSortOrder.xlAscending, Header:=xl.XlYesNoGuess.xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xl.Constants.xlTopToBottom, DataOption1:=xl.XlSortDataOption.xlSortNormal)
'Put list into an array for looping (values cannot be the result of formulas, must be constants)
MyArr = xlApp.WorksheetFunction.Transpose(ws.Range("EE2:EE" & ws.Rows.Count).SpecialCells(xl.XlCellType.xlCellTypeConstants))
'clear temporary worksheet list
ws.Range("EE:EE").Clear()
'Turn on the autofilter, one column only is all that is needed
ws.Range(vTitles).AutoFilter()
'Loop through list one value at a time
For Itm = 1 To UBound(MyArr)
ws.Range(vTitles).AutoFilter(Field:=vCol, Criteria1:=MyArr(Itm))
ws.Range("A1:A" & LR).EntireRow.Copy()
xlApp.Workbooks.Add()
ws.Range("A1").PasteSpecial(xl.XlPasteType.xlPasteAll)
ws.Cells.Columns.AutoFit()
MyCount = MyCount + ws.Range("A" & ws.Rows.Count).End(xl.XlDirection.xlUp).Row - 1
xlApp.ActiveWorkbook.SaveAs(SvPath & MyArr(Itm), xl.XlFileFormat.xlWorkbookNormal)
'ActiveWorkbook.SaveAs SvPath & MyArr(Itm) & Format(Date, " MM-DD-YY") & ".xlsx", 51 'use for Excel 2007+
xlApp.ActiveWorkbook.Close(False)
ws.Range(vTitles).AutoFilter(Field:=vCol)
Next Itm
'Cleanup
ws.AutoFilterMode = False
MsgBox("Rows with data: " & (LR - 1) & vbLf & "Rows copied to other sheets: " & MyCount & vbLf & "Hope they match!!")
xlApp.Application.ScreenUpdating = True
End Sub
End Module
Looks like you need to specify at least one optional parameter. Try this:
ws.Range(vTitles).AutoFilter(Field:=1)
I realize this was closed years ago, but I recently ran into this problem and wanted to add to the solution.
This seems to only work when specifically using the first optional Field parameter. I attempted this fix using the optional VisibleDropDown parameter and still got this error.
ws.Range["A1"].AutoFilter(VisibleDropDown: true); Gives error
ws.Range["A1"].AutoFilter(Field: 1); No error
Related
trying to turn an excel worksheet into a csv with only the data I need. Basically I need to only export columns that contain data. I'm pretty new to using vba macros. I've made a worksheet with cells linked to comboboxes for the first row in columns A:AF. The problem is that it seems these combobox-linked cells are treated as data when I either try to directly save the worksheet as a csv or export using the macro further below.
Example of first (column heading/variable name) line and then an example first row of one observation that I would ideally see in the exported csv:
Author,Year,Yield,Treatment
Smith,1999,2.6,notill
Where the Author...Treatment line originally came from selections in validation list restricted cells linked to comboboxes and the Smith...notill observation is something I paste in. Example of what I see instead:
Author,Year,Yield,Treatment,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
Smith,1999,2.6,notill,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
And then all the rows of observations below that are the same number of columns across.
This creates problems since I now have new variables that mess up merges if I do getnames in SAS. I can't specify the columns, since every time this is created and then exported, there are different numbers of columns. There are ways to deal with this if the columns you want are known, eg this answer . But I want to be able to able to say either ideally "copy only the columns that aren't empty," or maybe "copy only the columns with one of the following specific text in the first row" since A2:AF2 can only contain one of 32 certain things if they're not empty.
Here is the the code I've got that copies all these blank columns to a new workbook and saves that.
Sub CopyToCSV()
Dim MyPath As String
Dim MyFileName As String
'The path and file names:
MyPath = "C:\Users\Data\TxY\"
MyFileName = "TxY_" & Sheets("ValidationHeadings").Range("D3").Value & "_" & Format(Date, "ddmmyy")
'Makes sure the path name ends with "\":
If Not Right(MyPath, 1) = "\" Then MyPath = MyPath & "\"
'Makes sure the filename ends with ".csv"
If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"
'Copies the sheet to a new workbook:
Sheets("TxYdata").Copy
'The new workbook becomes Activeworkbook:
With ActiveWorkbook
'Saves the new workbook to given folder / filename:
.SaveAs Filename:= _
MyPath & MyFileName, _
FileFormat:=xlCSV, _
CreateBackup:=False
'Closes the file
.Close False
End With
End Sub
I know this has to be pretty simple (a column with nothing in it should stand out somehow, right?) but I searched for like 4 hours yesterday on how to do this. I would rather not demarcate the empty columns somehow in each worksheet that I am turning into a csv. Is there something I can add to
Sheets("TxYdata").Copy
to get it to only copy columns where I actually entered data, when I don't have a consistent number of columns in every sheet? Or something else that gets the job done.
Thanks so much!
Test this code.
Sub TransToCSV()
Dim vDB, vR() As String, vTxt()
Dim i As Long, n As Long, j As Integer
Dim objStream
Dim strTxt As String
Dim rngDB As Range, Ws As Worksheet
Dim MyPath As String, myFileName As String
Dim FullName As String
MyPath = "C:\Users\Data\TxY\"
myFileName = "TxY_" & Sheets("ValidationHeadings").Range("D3").Value & "_" & Format(Date, "ddmmyy")
If Not Right(MyPath, 1) = "\" Then MyPath = MyPath & "\"
If Not Right(myFileName, 4) = ".csv" Then myFileName = myFileName & ".csv"
FullName = MyPath & myFileName
Set Ws = Sheets("TxYdata")
Set objStream = CreateObject("ADODB.Stream")
With Ws
Set rngDB = .Range("a1", "d" & .Range("a" & Rows.Count).End(xlUp).Row)
'Set rngDB = .Range("a1").CurrentRegion <~~ Else use this codle
End With
vDB = rngDB
For i = 1 To UBound(vDB, 1)
n = n + 1
ReDim vR(1 To UBound(vDB, 2))
For j = 1 To UBound(vDB, 2)
vR(j) = vDB(i, j)
Next j
ReDim Preserve vTxt(1 To n)
vTxt(n) = Join(vR, ",")
Next i
strTxt = Join(vTxt, vbCrLf)
With objStream
'.Charset = "utf-8"
.Open
.WriteText strTxt
.SaveToFile FullName, 2
.Close
End With
Set objStream = Nothing
End Sub
You can approach this in different ways. Here is what I would do. Add a new sheet to your workbook. Have a FOR loop in your function to go through all columns in your sheet. For each column, you can use something like this to check if it holds any data:
iDataCount = Application.WorksheetFunction.CountIf(<worksheet object>.Range(<your column i.e. `"F:F"`>), "<>" & "")
If iDataCount is 0 then you know the column is empty. If its anything other than 0, copy it in the new sheet. Once you have complete the FOR loop, copy the new sheet into the .csv file. Finally remove the new sheet from your workbook (or you can leave it there. If you do, you just have to clear it before you run the process next time .. which can be done via the code as well)
Just starting out on VBA, and my code is painfully slow. I have a number of workbooks on a network drive, each with several worksheets. I am trying to fetch data from a number of non-contiguous ranges in each worksheet to a pre-designed worksheet, using the following code:
Private Function GetValue(path, file, sheet, ref)
'retrieve value
'// code
GetValue = ExecuteExcel4Macro(arg)
End Function
Sub UpdateModel1()
sheet = "blah blah"
Application.ScreenUpdating = False
'Outputs
destRow = 31 'destination row
destCol = 6 'destination column
srcRow = 50 'source row
For C = 23 To 31 'loop through source columns
ref = Cells(srcRow, C).Address
Cells(destRow, destCol) = GetValue(path, file, sheet, ref)
destCol = destCol + 1
Next C
Application.ScreenUpdating = True
End Sub
However, using a nested for loop in the sub procedure takes way too long. Any suggestions on how to improve this code? PS: this is an amateur's code, and I am just looking for something that does the work decently.
Here is a working example of what you are trying to do:
Sub TestGetSheetValue()
MsgBox GetSheetValue("N:\Tax Documents\", "Tax Stuff.xlsx", "Sheet1", "R1C3")
End Sub
Function GetSheetValue(strPath As String, strFile As String, strSheet As String, strCellRef As String)
GetSheetValue = ExecuteExcel4Macro("'" & strPath & "[" & strFile & "]" & strSheet & "'!" & strCellRef)
End Function
Obviously change what you pass into the function for your needs, note the address is R1C1 format.
The strSheet is the sheet name, not the sheet index.
Make sure you have a trailing \ on the path
Finally, try not to use names like file, path and sheet for variable names.
I'm new in Excel Macros and have no experience with VB or any language.
I have a sheet with a Price List, in this we have a field with a dropdown list with Contact Info (mail and cellphone) of our Salesman.
A second sheet contain a table with Name and ContactInfo.
Today, i use the dropdown to choose the salesman and export to pdf to specific directory.
I'm looking to export to PDF using a Macro doing these things. I've tried some macros without success. I want to use the name #Name to save in directory and #ContactInfo to replace in a specific field of pricelist.
What i have:
Sub MAKEPDF()
Dim dvCell As Range
Dim inputRange As Range
Dim c As Range
Dim i As Long
'Which cell has data validation
Set dvCell = Sheets("NUEVA LISTA").Range("A3")
'Determine where validation comes from
Set inputRange = Evaluate(dvCell.Validation.Formula1)
arrVendedores = Array("Name1", "Name2", "Name3", "Name4", "Name5", "Name6", "Name7")
i = 1
'Begin our loop
Application.ScreenUpdating = False
For Each c In inputRange
dvCell = c.Value
ChDir "D:\Google Drive\Lista de Precios\temp\" & arrVendedores(i)
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="(" & Format(Range("A4"), "yyyy-mm-dd") & ") Lista de precios.pdf"
'Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
i = i + 1
Next c
Application.ScreenUpdating = True
End Sub
This save in PDF perfectly but that array don't work as expected causing error 9 (index) and is better use current data from Table1#Name.
Can anyone help me to goal this?
Thanks and sorry for my bad english.
I found it hard to edit your code without seeing some of the inputs, but I got this to flow though with some dummy data.
Sub MAKEPDF()
Dim dvCell As Range
Dim inputRange As Range
Dim c As Range
Dim i As Long
Application.ScreenUpdating = False
'Which cell has data validation
Set dvCell = Sheets("NUEVA LISTA").Range("A3")
'You assigned the value of this cell later on but didn't use it so I removed the value assignment below.
'Determine where validation comes from
Set inputRange = Evaluate(dvCell.Validation.Formula1)
arrVendedores = Array("Name1", "Name2", "Name3", "Name4", "Name5", "Name6", "Name7")
'you might want to assign this in code, not sure if it is the sheet names but I assumed it is if not and just filenames to use.
For i = LBound(arrVendedores) To UBound(arrVendedores)
'this allows an array of any size to be iterated over with having to change the code.
ChDir "D:\Google Drive\Lista de Precios\temp\" & arrVendedores(i)
Worksheets(arrVendedores(i)).ExportAsFixedFormat Type:=xlTypePDF, Filename:="(" & Format(Range("A4"), "yyyy-mm-dd") & ") Lista de precios.pdf"
'you had activeworksheet here but it didn't seem to be changing, so if I assume the array is sheet names this will export those sheet else you will need to change to suit.
'Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
Next
Application.ScreenUpdating = True
End Sub
Thank you Captain, based on your answer i made a new macro as following
Sub MakePDF4()
Dim myTable As ListObject
Dim myArray As Variant
Dim x As Long
Dim vendedorDatos As Range
Dim vendedorCampoDatos As Range
Set myTable = Sheets("VENDEDORES").ListObjects("Table1")
myArray = myTable.DataBodyRange
For x = LBound(myArray) To UBound(myArray)
Application.ScreenUpdating = False
Set vendedorCampoDatos = (Sheets("NUEVA LISTA").Range("A3"))
vendedorCampoDatos = myArray(x, 2)
'ChDir "D:\Google Drive\Lista de Precios\temp\" & myArray(x, 1)
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="D:\Google Drive\Lista de Precios\temp\" & myArray(x, 1) & "\(" & Format(Range("A4"), "yyyy-mm-dd") & ") Lista de precios.pdf"
'Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
Next x
Application.ScreenUpdating = True
End Sub
It work as expected. I have some issue with setting ChDir with the array at the end but works when is setting in filename.
All data is in a unique file (may be i mispelled or confuse some words at explaining). One worksheet is the price list and a second worksheet contains the table with [#Name] and [#ContactInfo] of salesmen.
I use [#Name] to determinate in which directory i will save the PDF file and [#ContactInfo] to change in the worksheet of price list a unique field between salesmen
I am quite new in VBA and wrote a subroutine that copy-paste cells from one document into another one. Being more precise, I am working in document 1 where I have names of several product (all in column "A"). For these product, I need to look up certain variables (e.g. sales) in a second document.
The subroutine is doing the job quite nicely, but I want to use it as a funcion, i.e. I want to call the sub by typing in a cell "=functionname(productname)".
I am grateful for any helpful comments!
Best, Andreas
Sub copy_paste_data()
Dim strVerweis As String
Dim Spalte
Dim Zeile
Dim findezelle1 As Range
Dim findezelle2 As Range
Dim Variable
Dim Produkt
'Variable I need to copy from dokument 2
Variable = "frequency"
'Produkt I need to copy data from document 2
Produkt = Cells(ActiveCell.Row, 1)
'path, file and shhet of document 2
Const strPfad = "C:\Users\Desktop\test\"
Const strDatei = "Bezugsdok.xlsx"
Const strBlatt = "post_test"
'open ducument 2
Workbooks.Open strPfad & strDatei
Worksheets(strBlatt).Select
Set findezelle = ActiveSheet.Cells.Find(Variable)
Spalte = Split(findezelle.Address, "$")(1)
Set findezelle2 = ActiveSheet.Cells.Find(Produkt)
Zeile = Split(findezelle2.Address, "$")(2)
'copy cell that I need
strZelle = Spalte & Zeile 'Zelladresse
strVerweis = "'" & strPfad & "[" & strDatei & "]" & strBlatt & "'!" & strZelle
'close document 2
Workbooks(strDatei).Close savechanges:=False
With ActiveCell
.Formula = "=IF(" & strVerweis & "="""",""""," & strVerweis & ")"
.Value = .Value
End With
End Sub
Here is an example to create a function that brings just the first 3 letters of a cell:
Public Function FirstThree(Cell As Range) As String
FirstThree = Left(Cell.Text, 3)
End Function
And using this in a Excel worksheet would be like:
=FirstThree(b1)
If the sub works fine and you just want to make it easier to call you can add a hotkey to execute the Macro. In the developer tab click on Macros then Options. You can then add a shortcut key (Crtl + "the key you want" it can be a shortcut key already used like C, V, S, but you will lose those functions (Copy, Paste Save, Print)
enter image description here
I have the below working code which loops through each worksheet and if the value defined in the range (myrange) is 'Y', it outputs those sheets into a single PDF document. My challange is that i want to define the order that they are output in the PDF based on the number value in the range (for example 1,2,3,4,5,6,7 etc) instead of 'Y'. I plan on using the same column in the myrange to check whether it needs to be output to PDF, by simply swapping the 'Y' for a number, such as '1' and '2'.
Currently the order is defined based on the location of the worksheet tabs. from left to right.
Any help will be much appreciated.
Sub Run_Me_To_Create_Save_PDF()
Dim saveAsName As String
Dim WhereTo As String
Dim sFileName As String
Dim ws As Worksheet
Dim printOrder As Variant '**added**
Dim myrange
On Error GoTo Errhandler
Sheets("Settings").Activate
' Retrieve value of 'Period Header' from Settings sheet
Range("C4").Activate
periodName = ActiveCell.Value
' Retrieve value of 'File Name' from Settings sheet
Range("C5").Activate
saveAsName = ActiveCell.Value
' Retrieve value of 'Publish PDF to Folder' from Settings sheet
Range("C6").Activate
WhereTo = ActiveCell.Value
Set myrange = Worksheets("Settings").Range("range_sheetProperties")
' Check if Stamp-field has any value at all and if not, add the current date.
If Stamp = "" Then Stamp = Date
' Assemble the filename
sFileName = WhereTo & saveAsName & " (" & Format(CDate(Date), "DD-MMM-YYYY") & ").pdf"
' Check whether worksheet should be output in PDF, if not hide the sheet
For Each ws In ActiveWorkbook.Worksheets
Sheets(ws.Name).Visible = True
printOrder = Application.VLookup(ws.Name, myrange, 4, False)
If Not IsError(printOrder) Then
If printOrder = "Y" Then
Sheets(ws.Name).Visible = True
End If
Else: Sheets(ws.Name).Visible = False
End If
Next
'Save the File as PDF
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
sFileName, Quality _
:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
' Unhide and open the Settings sheet before exiting
Sheets("Settings").Visible = True
Sheets("Settings").Activate
MsgBox "PDF document has been created and saved to : " & sFileName
Exit Sub
Errhandler:
' If an error occurs, unhide and open the Settings sheet then display an error message
Sheets("Settings").Visible = True
Sheets("Settings").Activate
MsgBox "An error has occurred. Please check that the PDF is not already open."
End Sub
---------------------- UPDATE: -------------------------------------
Thank you for all your input so far. I did get it to work briefly, but with more playing i've become stuck. I am now receiving a 'Subscript our of range' error with the below code at :
If sheetNameArray(x) <> Empty Then
Any ideas?
Sub Run_Me_To_Create_Save_PDF()
Dim saveAsName As String
Dim WhereTo As String
Dim sFileName As String
Dim ws As Worksheet
Dim myrange
ReDim sheetNameArray(0 To 5) As String
Dim NextWs As Worksheet
Dim PreviousWs As Worksheet
Dim x As Integer
'On Error GoTo Errhandler
Sheets("Settings").Activate
' Retrieve value of 'Period Header' from Settings sheet
Range("C4").Activate
periodName = ActiveCell.Value
' Retrieve value of 'File Name' from Settings sheet
Range("C5").Activate
saveAsName = ActiveCell.Value
' Retrieve value of 'Publish PDF to Folder' from Settings sheet
Range("C6").Activate
WhereTo = ActiveCell.Value
' Check if Stamp-field has any value at all and if not, add the current date.
If Stamp = "" Then Stamp = Date
' Assemble the filename
sFileName = WhereTo & saveAsName & " (" & Format(CDate(Date), "DD-MMM-YYYY") & ").pdf"
Set myrange = Worksheets("Settings").Range("range_sheetProperties")
For Each ws In ActiveWorkbook.Worksheets
printOrder = Application.VLookup(ws.Name, myrange, 4, False)
If Not IsError(printOrder) Then
printOrderNum = printOrder
If printOrderNum <> Empty Then
'Add sheet to array
num = printOrderNum - 1
sheetNameArray(num) = ws.Name
End If
End If
Next
MsgBox Join(sheetNameArray, ",")
'Order Tab sheets based on array
x = 1
Do While Count < 6
If sheetNameArray(x) <> Empty Then
Set PreviousWs = Sheets(sheetNameArray(x - 1))
Set NextWs = Sheets(sheetNameArray(x))
NextWs.Move after:=PreviousWs
x = x + 1
Else
Count = Count + 1
x = x + 1
End If
Loop
Sheets(sheetNameArray).Select
'Save the File as PDF
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sFileName, Quality _
:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
' open the Settings sheet before exiting
Sheets("Settings").Activate
MsgBox "PDF document has been created and saved to : " & sFileName
Exit Sub
Errhandler:
' If an error occurs, unhide and open the Settings sheet then display an error message
Sheets("Settings").Visible = True
Sheets("Settings").Activate
MsgBox "An error has occurred. Please check that the PDF is not already open."
End Sub
You would want to define the worksheets in an array.
This example uses a static array, knowing the sheets order and what you want to print in advance. This does work.
ThisWorkbook.Sheets(Array("Sheet1","Sheet2","Sheet6","Master","Sales")).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, fileName:=sFileName, Quality _
:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
The problem is that if a sheet is hidden, it will fail on the selection.
So you will need to already know which sheets pass the test to be printed or not before declaring the Array. Therefore you will need a dynamic array to build the list of Worksheets.
I did change how your PrintOrder works, instead of making the sheet invisible, it simply doesn't add it to the array, or vice versa, adds the ones you want to the array. Then you select the array at the end, and run your print macro that works.
I tested this using my own test values, and am trusting that your PrintOrder Test works. But this does work. I used it to print time sheets that only have more than 4 hours per day, and it succeeded, merging 5 sheets out of a workbook with 11 sheets into one PDF.. All of them qualified the test.
TESTED: Insert this instead of your For Each ws and add the Variable Declarations with yours
Sub DynamicSheetArray()
Dim wsArray() As String
Dim ws As Worksheet
Dim wsCount As Long
wsCount = 0
For Each ws In Worksheets
printOrder = Application.VLookup(ws.Name, myrange, 4, False)
If Not IsError(printOrder) Then
If printOrder = "Y" Then
wsCount = wsCount + 1
ReDim Preserve wsArray(1 To wsCount)
'Add sheet to array
wsArray(wsCount) = ws.Name
End If
End If
Next
Sheets(wsArray).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, fileName:=sFileName, Quality _
:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End Sub
edit: further explained context of my code to OP
Here is a bit of code I came up with. Basically you would want to take this and adapt it to fit your specific needs but the general idea should work!
Sub MovingPagesAccordingToNumberInRange()
Dim ws As Worksheet
Dim NextWs As Worksheet
Dim PreviousWs As Worksheet
Dim sheetNameArray(0 To 400) As String
Dim i As Integer
'This first loop is taking all of the sheets that have a number
' placed in the specified range (I used Cell A1 of each sheet)
' and it places the name of the worksheet into an array in the
' order that I want the sheets to appear. If I placed a 1 in the cell
' it will move the name to the 1st place in the array (location 0).
' and so on. It only places the name however when there is something
' in that range.
For Each ws In Worksheets
If ws.Cells(1, 1).Value <> Empty Then
num = ws.Cells(1, 1).Value - 1
sheetNameArray(num) = ws.Name
End If
Next
' This next section simply moves the sheets into their
' appropriate positions. It takes the name of the sheets in the
' previous spot in the array and moves the current spot behind that one.
' Since I didn't know how many sheets you would be using I just put
' A counter in the prevent an infinite loop. Basically if the loop encounters 200
' empty spots in the array, everything has probably been organized.
x = 1
Do While Count < 200
If sheetNameArray(x) <> Empty Then
Set PreviousWs = sheets(sheetNameArray(x - 1))
Set NextWs = sheets(sheetNameArray(x))
NextWs.Move after:=PreviousWs
x = x + 1
Else
Count = Count + 1
x = x + 1
End If
Loop
End Sub