Currently learning VBA in bits and pieces.
Confused on where to insert a condition in the following piece to check each worksheet respectively on cell address E8 for example for ANY entry other than “”.
Sub SaveWorkshetAsPDF()
Dim ws As Worksheet
timestamp = Format(Date, "mmddyyyy ")
For Each ws In Worksheets
ws.Select
ws.ExportAsFixedFormat xlTypePDF, Filename:= _
ActiveWorkbook.Path & "\" & timestamp & ws.Name & ".pdf"
Next ws
End Sub
Any assistance would be amazing.
Want it to stop exporting if a value is present in a specified cell.
I think this should get you what you need. I included some comments that might help out a little and give you a method to have a condition to check.
A couple notes to improve:
Always good to define variable such as timestamp.
No need to actively select the sheet, you can get the file's workbook path using the parent property.
For items that are hard-coded, I'm a fan of putting the values at the top of the macro as constants. It makes changing things easier.
Hope this helps.
Sub SaveWorkshetAsPDF()
Const theValueToStop As String = "Stop" 'or whatever, if it's a number change to Long
Const theAdddress As String = "E8" 'makes it easier to find and change if needed.
Dim ws As Worksheet, timestamp As String
timestamp = Format(Date, "mmddyyyy ")
For Each ws In Worksheets
'no neeed to select use parent property for address.
'ws.Select
If ws.Range(theAdddress).Value <> theValueToStop Then
ws.ExportAsFixedFormat xlTypePDF, Filename:= _
ws.Parent.Path & "\" & timestamp & ws.Name & ".pdf"
End If
Next ws
End Sub
Related
The below short VBA code exports multiple PDFs from a workbook, it cycles through the worksheets to see if anything is contained in cell A1 then exports as PDF only if the cell is populated.
Sub PrintPDFs()
Const theValueToStop As String = ""
Const theAddress As String = "A1"
Dim ws As Worksheet
timestamp = Format(Date, "mmddyyyy ")
For Each ws In Worksheets
If ws.Range(theAddress).Value <> theValueToStop Then
ws.ExportAsFixedFormat xlTypePDF, IgnorePrintAreas:=False, Filename:= _
ActiveWorkbook.Path & "\" & date & "marketstudy " & ws.Name & ".pdf"
End If
Next ws
End Sub
This has worked perfectly for myself, however some of my colleagues are having difficulty with printing as it sometimes is formatted differently. I want it to always fit every worksheet onto a single PDF.
Appreciate any help given.
I really appreciate if someone here would help me crack this problem which i cant find the solution (and sorry for my bad english).
So i have multiple excels in one folder. every excel in it have same format 1st sheet for reference of every sheet, 2nd sheet for consolidation data, and 3rd sheet and the rest for the data to be consolidated. Every excel in the folder have various amount of sheet.
What i want to do is i want to copy data from range A27:AJ500 that begin from 3rd sheet to every sheet after, into another new workbook in sheet1 and paste it begin from cell A27 over and over into the bottom and looping for every excel in folder.
i dont have enough ability yet to write my own script but i managed to understand some and combine it into this script.
Sub Download_Data()
Path = "C:\Users\ASUS\Desktop\Done\"
Filename = Dir(Path & "*.xlsm")
'to open every excel in my folder
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True '--> i only managed to do it right till here
'supposed to copy range in every sheet of excel in my folder into different workbook
For Each ws In thiswoorkbook.Worksheets '--> i try write this code but i am confused to do what i want from here and i know this code is nowhere near true
With ws
If .Name <> "GABUNGAN" Then
range("A27:AJ500").Select
Selection.copy
Workbooks("Tes.xlsm").range("A27").PasteSpecial Paste:=xlPasteValues
End If
End With
Next ws
Workbooks(Filename).Close
Filename = Dir()
Loop
Application.Goto ActiveWorkbook.Sheets("sheet1").range("A1")
End Sub
I've been searching for the code not only i cant customize it to this code but also i cant understand what is wrong in the code therefore i write this question. Any help will be appreciated, thanks in advance for your attention wish you safe and sound.
Try this: (tested)
Dim sourcewb As Workbook
Dim destwb As Workbook
Dim y As Long
Dim ws As Worksheet
Dim strPath As String, strFilename As String
strPath = "C:\Users\ASUS\Desktop\Done\"
strFilename = Dir(strPath & "*.xlsm")
y = 27
Set destwb = ThisWorkbook
Do While strFilename <> ""
Set sourcewb = Workbooks.Open(Filename:=strPath & strFilename, ReadOnly:=True)
For Each ws In sourcewb.Worksheets
With ws
If .Name <> "name of reference sheet" And .Name <> "name of consolidation sheet" Then
.Range("A27:AJ500").Copy
destwb.Worksheets("sheet1").Range("A" & y).PasteSpecial Paste:=xlPasteValues
y = y + (500 - 27) + 1
End If
End With
Next ws
sourcewb.Close False
strFilename = Dir()
Loop
First time programmer here, started teaching myself VBA a few days ago to write this. The goal is to have the code be able to reference two workbooks that are not constants. One is selected by the user and the other is running the macro. I have defined the workbooks in a sub statement previous, but when I try to reference it in a sub statement further down the line I get error '9' "subscript out of range." I have tried using call but it also came up with undefined errors (it could be that I don't understand the 'call' statement).
If you have an additional moment to look over my formula and make sure it is formatted correctly that would be a big help as well. I just know it is going to be a huge problem when I get there.
P.S. I just noticed that I have been spelling reference wrong in my code this entire time. Go ahead, laugh.
'''
Sub Openfile()
Dim FileToOpen As Variant, wbRefrence As Workbook
Dim wbOracle As Workbook
Set wbOracle = ThisWorkbook
FileToOpen = Application.GetOpenFilename(FileFilter:="Excel Workbooks (*.xls*),*.xls*", Title:="Open Database File")
If FileToOpen = False Then
MsgBox "No file selected, cannot continue." 'If the user does not open a file this message is displayed
Exit Sub 'If no file is selected the program stops running
End If
Set wbRefrence = Workbooks.Open(FileToOpen)
Workbooks.Open (FileToOpen) 'If a file is selected it opens that file.
Call LoopTest1
End Sub
Sub LoopTest1()
Dim BlankCell As Boolean
Dim i As Long
'Loop until a blank cell is encountered
Do While BlankCell = False
i = i + 1
If Cells(i, "C").Value = "" Then
BlankCell = True 'When it reaches a blank cell BlankCell will now be true which ends the do while formula.
End If
Application.Workbooks("wbOracle").Sheets("Cancel Requisition Lines").Range("C16").Select
'Formula for "do while" condition
Selection.Formula = "=IF(INDEX(['wbRefrence']Sheet1!'A2000:M2000',MATCH(1,(['wbRefrence']Sheet1!'D:D'=['wbOracle']'Cancel Requisition Lines'!'C16')*(['wbRefrence']Sheet1!'E:E'=['wbOracle']'Cancel Requisition Lines'!'I16')*(['wbRefrence']Sheet1!'F:F'=['wbOracle']'Cancel Requisition Lines'!'J16'),0),9)>=['wbOracle']'Cancel Requisition Lines'!M:M, ""materials supplied"","""")"
Loop
End Sub
'''
You've got a great start to your code, so here are a few things to help get you on your way...
Always use Option Explicit.
Try to define your variables as close as possible to its first use (your current code is short enough to not matter much, its just a habit to get into).
The Call usage has been deprecated and it's not needed. If you want to call a function or sub, just use the name of that routine.
Also, if you have a sub call that is by itself in a single statement, the parens are NOT required to enclose the parameters. If you're making the call in a compound or assignment statement, you MUST use the parens.
A good habit is to always make it clear what workbook, worksheet, and range you are referencing with a fully qualified reference every single time. This one thing trips up so many VBA users.
For example, in your LoopTest1 code, you are referring to Cells. Without any qualifying reference, the VBA code assumes you are referring to the currently active worksheet (whichever and whereever that is). So define some intermediate variables and make it clear (see example below).
To help clear up any confusion in your LoopTest1 sub, I added some parameters so that you can work on any two workbooks you choose.
My own preference is to build up a complicated formula in a separate string variable so that I can examine it in the debugger and make sure it's exactly right. So you can see I defined a formulaText string and built up your formula.
I "corrected" a few things I found in the formula (but I cannot tell you it will work), including:
Using the FullName property of both workbooks in the formula (so you never have it hard-coded)
Using the Name property of the worksheet (so you never have it hard-coded)
Properly arranging the single-tick marks for the proper workbook/worksheet reference (overall, you were using too many single-ticks in your formula)
Only you can determine if the formula is actually what you want and if it works. But that might be a separate question :)
Option Explicit
Sub Openfile()
Dim wbOracle As Workbook
Set wbOracle = ThisWorkbook
Dim FileToOpen As Variant
FileToOpen = Application.GetOpenFilename( _
FileFilter:="Excel Workbooks (*.xls*),*.xls*", _
Title:="Open Database File")
If FileToOpen = False Then
MsgBox "No file selected, cannot continue."
Exit Sub
End If
Dim wbReference As Workbook
Set wbReference = Workbooks.Open(FileToOpen)
Workbooks.Open FileToOpen
LoopTest1 wbOracle, wbReference, "Cancel Requisition Lines"
End Sub
Sub LoopTest1(ByRef wbOracle As Workbook, _
ByRef wbReference As Workbook, _
ByVal oracleSheetName As String)
Dim wsOracle As Worksheet
Set wsOracle = wbOracle.Sheets(oracleSheetName)
Dim wsReference As Worksheet
Dim referenceCell As Range
Set wsReference = wbReference.Sheet1
Set referenceCell = wsReference.Range("C1")
Dim formulaText As String
Do While Not IsEmpty(referenceCell)
formulaText = "=IF(INDEX('[" & wbReference.Name & _
"]Sheet1'!A2000:M2000,MATCH(1,(['" & wbReference.FullName & _
"]Sheet1'!D:D=['" & wbOracle.FullName & _
"]" & wsOracle.Name & "'!C16)*('[" & wbReference.FullName & _
"]Sheet1!E:E=[" & wbOracle.FullName & _
"]" & wsOracle.Name & "'!'I16')*([" & wbReference.FullName & _
"]Sheet1!F:F=[" & wbOracle.FullName & _
"]" & wsOracle.Name & "'!'J16'),0),9)>=[" & wbOracle.FullName & _
"]" & wsOracle.Name & "'!M:M, ""materials supplied"","""")"
wsOracle.Range("C16").Formula = formulaText
Set referenceCell = ReferenceCell.Offset(1, 0)
Loop
End Sub
I am trying to create some coding to be used across several workbooks. Within the workbooks I want to update certain sheets. These specific sheets are always in the same exact format and I want to update the same exact cells every time.
I am trying to create a loop and the "Do While" coding looks at the sheet need to determine if it needs to loop or not.
Below is the code I am using, and I keep getting the run time error '424': object required in vba. Where I will put the rest of my coding I have a msgbox there as a place holder just to get the code to work.
Do While WS.Name Like "P&L - "
If Range("S306") <> 0 Then
MsgBox ("tEST GOOD")
Worksheets(ActiveSheet.Index + 1).Select
End If
Loop
Perhaps something like this?
Sub tgr()
Dim wb As Workbook
Dim ws As Worksheet
'Loop through each currently open Excel workbook
'If you instead need to loop through files in a folder, code would be different
For Each wb In Application.Workbooks
'loop through all sheets in one of the workbooks
For Each ws In wb.Worksheets
'Compare the worksheet name and cell S306 value
If ws.Name Like "P&L - *" _
And ws.Range("S306") <> 0 Then
'Match found, your code would go here
MsgBox "Workbook: " & wb.Name & Chr(10) & _
"Worksheet: " & ws.Name
End If
Next ws
Next wb
End Sub
I have an excel sheet which has some huge data. Data is organized as follows,
A set of 7 columns and n rows; as in a table, and 1000s of such tables are placed horizontally with an empty column to separate. A screenshot is below..
...
I just want to have data of every 'table' saved into a different file. Manually it would take ever! So, Is there a macro or something I would automate this task with.
I am not well versed with writing macros or any VBA stuff.
Thanks,
Tony has a valid point when he says
If the table starting at C1 finishes on row 21, does the next table start at C23? If the table starting at K1 finishes on row 15, does the next table start at K17 or K23?
So here is a code which will work in any condition i.e data is set horizontally or vertically.
DATA SNAPSHOT
CODE
'~~> Change this to the relevant Output folder
Const FilePath As String = "C:\Temp\"
Dim FileNumb As Long
Sub Sample()
Dim Rng As Range
Dim AddrToCopy() As String
Dim i As Long
On Error GoTo Whoa
Application.ScreenUpdating = False
Set Rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants, xlTextValues)
If Not Rng Is Nothing Then
AddrToCopy = Split(Rng.Address, ",")
FileNumb = 1
For i = LBound(AddrToCopy) To UBound(AddrToCopy)
ExportToSheet (AddrToCopy(i))
Next i
End If
MsgBox "Export Done Successfully"
LetsContinue:
Application.ScreenUpdating = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub
Sub ExportToSheet(rngAddr As String)
Range(rngAddr).Copy
Workbooks.Add
ActiveSheet.Paste
ActiveWorkbook.SaveAs Filename:= _
FilePath & "Output" & FileNumb & ".csv" _
, FileFormat:=xlCSV, CreateBackup:=False
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True
FileNumb = FileNumb + 1
End Sub
NOTE: The above code will work for cells with only Text Values. For cells with only Numeric Values you have to use
Set Rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants, xlNumbers)
And for AlphaNumeric Values (As in your question above), use this
Set Rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants)
HTH
Sid
As long as there is a blank row and a blank column around any datasets, this will use the AREAS() method to put them all in separate workbooks.
As per the prior example, it saves as CSV, but of course you can save it as you wish.
Option Explicit
Sub ExportDataGroups()
Dim fPATH As String, Grp As Long, DataRNG As Range
fPATH = "C:\Path\Where\I\Want\My\Files\Saved\" 'remember the final \
Application.ScreenUpdating = False
Set DataRNG = ActiveSheet.UsedRange
For Grp = 1 To DataRNG.Areas.Count
DataRNG.Areas(Grp).Copy
Sheets.Add
Range("A1").PasteSpecial
ActiveSheet.Move
ActiveWorkbook.SaveAs Filename:=fPATH & "-" & Format(Grp, "0000") & ".csv", _
FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close
Next Grp
MsgBox "A total of " & Grp & " files were created"
Application.ScreenUpdating = True
End Sub
In your response to my comment you state: "File name, I never thought about it. Could be anything for now." From bitter experience I can tell you that dealing with thousands of files with system generated names is a nightmare. You need to fix the name problem now.
I am also nervous about AddrToCopy = Split(Rng.Address, ","). Rng.Address will be of the form: "$C$1:$I$16, $K$1:$Q$16, $S$1:$Y$16, $C18$I$33, $K$18:$Q$33, $S$18:$Y$33, ...". If you search the internet you will find sites that tell you that Rng.Address has a maximum length of 253 characters. I do not believe this is correct. In my experience, Rng.Address is truncated at a complete sub-range. My experimentation was with Excel 2003 but I have found noting on the internet to suggest this limitation has been fixed in later versions of Excel. You much check Rng.Address with your version of Excel! I am not familar with Jerry Beaucaire, although he offers an interesting solution. Sid Rout always produces excellent code. If there is a problem, I am sure they will be able to fix it.
However, the real purpose of this "answer" is to say I would split this problem into three. This has lots of advantages and no disadvantages of which I am aware.
Step 1. Create a new worksheet, TableSpec, with the following columns:
A Worksheet name. (If tables are spread over more than worksheet)
B Range. For example: C1:I16, K1:Q16
C - I Headings from table. For example, AAPL, Open, High, Low, Close, Volume, AdjClose
Step 2. Check worksheet TableSpec; for example, are all table listed? Think about the file name and add column H to contain it. I read one of your comments to mean you would "AAPL" as the filename for the first table in which case you could set H2 to "=C2". Is "AAPL" unique? You could had a sequence number. There are lots of choices which you can think about before you generate any files.
Step 3. Worksheet TableSpec now gives all the information necessary to generate your files. You could delete most of the contents and test the file creation code on a couple rows.
I hope you can see advantages of this stepped approach, partcularly if your VBA is weak. Best of luck.