Selecting first row/last row only from saved file to print - vba

I've almost completed my code where I save data, export as pdf, all that jazz. I was wondering if there was a way to incorporate [excel sheet].PageSetup.PrintTitleRows = "$[firstrow]$[lastrow]"; into my program. I'm not sure if this should be manipulated in some way. The first row holds all the units and the report saves data in each row, however, I only want the last row of data (new stuff), but with the unit row (row 1) as well. Here's my code, not entirely sure where it put it (proably near the end):
Sub Save_History()
'copies data from calculation page
Sheets("Simple Calculation").Select
Range("A2:I2").Select
Selection.Copy
Sheets("Media History").Select
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Application.DisplayAlerts = False`
' Check for year folder and create if needed
If Len(Dir("C:blah\" & Year(Date), vbDirectory)) = 0 Then
MkDir "C:blah\" & Year(Date)
End If
' Check for month folder and create if needed
If Len(Dir("C:blah\" & Year(Date) & "\" & MonthName(month(Date), False), vbDirectory)) = 0 Then
MkDir "C:blah\" & Year(Date) & "\" & MonthName(month(Date), False)
End If
' Check for day folder and create if needed
If Len(Dir("C:blah\" & Year(Date) & "\" & MonthName(month(Date), False) & "\" & Day(Date), vbDirectory)) = 0 Then
MkDir "C:blah\" & Year(Date) & "\" & MonthName(month(Date), False) & "\" & Day(Date)
End If
strFilePath = "C:blah\" & Year(Date) & "\" & MonthName(month(Date), False) & "\" & _
Format(Date, "mm.dd.yy") & "_" & Format(Time(), "hh.mm.ssAM/PM") & ".pdf"
ActiveSheet.ExportAsFixedFormat Type:=x1TypePDF, Filename:=strFilePath, _
Quality:=x1QualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True _
Application.DisplayAlerts = True
' Popup Message
MsgBox "File Saved As:" & vbNewLine & strFilePath
End Sub

Here's what worked (finally) I just Copied/pasted again.
Sub Save_History()
Sheets("Simple Calculation").Select
Range("A2:I2").Select
Selection.Copy
Sheets("New Media Report").Select
Range("A1").End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'copies data from calculation page
Sheets("Simple Calculation").Select
Range("A2:I2").Select
Selection.Copy
Sheets("Media History").Select
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Application.DisplayAlerts = False
' Check for year folder and create if needed
If Len(Dir("C:blah\" & Year(Date), vbDirectory)) = 0 Then
MkDir "C:blah\" & Year(Date)
End If
' Check for month folder and create if needed
If Len(Dir("C:blah\" & Year(Date) & "\" & MonthName(month(Date), False), vbDirectory)) = 0 Then
MkDir "C:blah\" & Year(Date) & "\" & MonthName(month(Date), False)
End If
' Check for day folder and create if needed
If Len(Dir("C:blah\" & Year(Date) & "\" & MonthName(month(Date), False) & "\" & Day(Date), vbDirectory)) = 0 Then
MkDir "C:blah\" & Year(Date) & "\" & MonthName(month(Date), False) & "\" & Day(Date)
End If
strFilePath = "C:blah\" & Year(Date) & "\" & MonthName(month(Date), False) & "\" & _
Format(Date, "mm.dd.yy") & "_" & Format(Time(), "hh.mm.ssAM/PM") & ".pdf"
ActiveSheet.ExportAsFixedFormat Type:=x1TypePDF, Filename:=strFilePath, _
Quality:=x1QualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True _
Application.DisplayAlerts = True
' Popup Message
MsgBox "File Saved As:" & vbNewLine & strFilePath
End Sub

Related

How to save/export a pdf to a certain folder using VBA

I have created a database in access that stores data about my work.
I have also created a report that is linked to a table in this DB that is run by a Macro which creates a file (exports) through VBA onto my desktop. Right now I am trying to change this so that the file will check the directory (i.e desktop), create a year folder (i.e 2020) if it not created, then check inside that folder for the month name (i.e January) if this is not created and then a day folder etc for every month. Right now this works fine. But I am struggling to get the file to output to this location when it has completed these checks. Just not sure how to word it while keeping the DoCmd.OutputTo etc... Heres some code to show you what I mean:
Function Reportmacro()
On Error GoTo Reportmacro_Err
' Check for year folder and create if needed
If Len(Dir("H:TEST\" & Year(Date), vbDirectory)) = 0 Then
MkDir "H:TEST\" & Year(Date)
End If
' Check for month folder and create if needed
If Len(Dir("H:TEST\" & Year(Date) & "\" & MonthName(Month(Date), False), vbDirectory)) = 0 Then
MkDir "H:TEST\" & Year(Date) & "\" & MonthName(Month(Date), False)
End If
' Check for day folder and create if needed
If Len(Dir("H:TEST\" & Year(Date) & "\" & MonthName(Month(Date), False) & "\" & Day(Date), vbDirectory)) = 0 Then
MkDir "H:TEST\" & Year(Date) & "\" & MonthName(Month(Date), False) & "\" & Day(Date)
DoCmd.OutputTo acOutputReport, "Changeover Car Report", "PDFFormat(*.pdf)", "CCReport" & Day(Date) & "_" & Month(Date) & "_" & Year(Date) & ".pdf", False, "", , acExportQualityPrint
End If
Reportmacro_Exit:
Exit Function
Reportmacro_Err:
MsgBox Error$
Resume Reportmacro_Exit
End Function
At the moment it is going to a "TEST" folder but same logic applies.
try this, code remains the same, only added the folder path to the file name:
Function Reportmacro()
On Error GoTo Reportmacro_Err
Dim fPath as String
' Check for year folder and create if needed
If Len(Dir("H:TEST\" & Year(Date), vbDirectory)) = 0 Then
MkDir "H:TEST\" & Year(Date)
End If
' Check for month folder and create if needed
If Len(Dir("H:TEST\" & Year(Date) & "\" & MonthName(Month(Date), False), vbDirectory)) = 0 Then
MkDir "H:TEST\" & Year(Date) & "\" & MonthName(Month(Date), False)
End If
' Check for day folder and create if needed
fPath = "H:TEST\" & Year(Date) & "\" & MonthName(Month(Date), False) & "\" & Day(Date)
If Len(Dir(fPath, vbDirectory)) = 0 Then
MkDir fPath
DoCmd.OutputTo acOutputReport, "Changeover Car Report", "PDFFormat(*.pdf)", fPath & "\" & "CCReport" & Day(Date) & "_" & Month(Date) & "_" & Year(Date) & ".pdf", False, "", , acExportQualityPrint
End If
Reportmacro_Exit:
Exit Function
Reportmacro_Err:
MsgBox Error$
Resume Reportmacro_Exit
End Function
check the docs: https://learn.microsoft.com/en-us/office/vba/api/access.docmd.outputto

Explanation on uploading files to share point using vba

I am trying to upload files to a sharepoint site, and for some reason something weird happens, where the first file with never upload, but a random amount of files after that will upload, and then sometimes an error of 'Getting list of available content types and properties' appears.
So 2 things that i need some help with, firstly how do i make it so the first file will upload, and then why am i sometimes getting the content error
here is the code i am using
If Dir("\\server\content\90002613\Documents\TestGB\" & saveFileName, vbDirectory) = "" Then
MkDir ("\\server\content\90002613\Documents\TestGB\" & saveFileName)
End If
If Dir("\\server\content\90002613\Documents\TestGB\" & saveFileName & "\" & Format(lDate, "yyyy"), vbDirectory) = "" Then
MkDir ("\\server\content\90002613\Documents\TestGB\" & saveFileName & "\" & Format(lDate, "yyyy"))
End If
If Dir("\\server\content\90002613\Documents\TestGB\" & saveFileName & "\" & Format(lDate, "yyyy"), vbDirectory) <> "" Then
With ActiveWorkbook
Application.ActiveWorkbook.SaveAs Filename:="https://server/content/90002613/Documents/TestGB/" & saveFileName & "/" & Format(lDate, "yyyy") & "\GB RSM P" & Format(lDate, "mm") & "FY" & Format(lDate, "yyyy") & " " & saveFileName & ".xlsx"
Application.ActiveWorkbook.Close False
End With
End If
thank you
You should be able to save to the UNC path:
Const BASE_DIR As String = "\\server\content\90002613\Documents\TestGB\"
Dim dt
If Dir(BASE_DIR & saveFileName, vbDirectory) = "" Then
MkDir (BASE_DIR & saveFileName)
End If
dt = Format(lDate, "yyyy")
If Dir(BASE_DIR & saveFileName & "\" & dt, vbDirectory) = "" Then
MkDir (BASE_DIR & saveFileName & "\" & dt)
End If
With ActiveWorkbook
.SaveAs Filename:="BASE_DIR " & saveFileName & "\" & dt & _
"\GB RSM P" & Format(lDate, "mm") & "FY" & _
Format(lDate, "yyyy") & " " & saveFileName & ".xlsx"
.Close False
End With

excel vba doesnt follow save path and saves in my documents

I am quite new to vba. I wrote a piece of code to save an excel workbook. the original save path works and the file gets saved there, but when i try to change it (to a shared directory) it doesn't listen.Instead, it just saves in My Documents. Below is the code that works.
Any help would be appreciated
Sheets("Sheet1").Select
Sheets("Sheet1").Copy
ChDir "C:\Users\SI\Desktop\Generator"
ActiveWorkbook.SaveAs Filename:= _
Range("B4").Value & " TRS - " & Range("E6").Value & " vs " _
& Range("E7").Value & " - " & Format(Date, "dd-mm-yyyy"), FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
Sheets("ST").Select
Just specify the full path in the Filename argument for the SaveAs
Sheets("Sheet1").Select
Sheets("Sheet1").Copy
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\SI\Desktop\Generator\" & Range("B4").Value & " TRS - " & Range("E6").Value & " vs " _
& Range("E7").Value & " - " & Format(Date, "dd-mm-yyyy"), FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
Sheets("ST").Select

Save a single worksheet as CSV/xlsx file error 1004 (but does work when use 'export as fixed format' for PDF)

I have managed to get this to save as a PDF using 'ExportAsFixedFormat', but when I try to use 'SaveAs' to get a CSV (although I would accept xlsx too!) I get:
Run time error: 1004 Application defined or Object defined error
I have spent way to long trying to do this and can't find any answers that work for me online...
Sub SaveTrackingSheet()
Dim NewPathTrack As String
NewPathTrack = Application.ThisWorkbook.Path & "\PDF Outputs\" & Range("NameTrack").Text & "\"
If Dir(NewPathTrack, 63) = "" Then MkDir NewPathTrack
Dim NewPathDealer As String
NewPathDealer = NewPathTrack & Range("CodeTrack").Text & " - " & Range("NameTrack").Text & "\"
If Dir(NewPathDealer, 63) = "" Then MkDir NewPathDealer
Sheets("Tracking Sheet").SaveAs _
Filename:=NewPathDealer & "\" & Range("CodeTrack").Text & " - Tracking Sheet" & ".csv", _
FileFormat:=xlCSV, _
ConflictResolution:=2, _
Local:=True, _
CreateBackup:=False
End Sub
This is the line that errors:
Sheets("Tracking Sheet").SaveAs _
Filename:=NewPathDealer & "\" & Range("DealerCodeTrack").Text & " - Tracking Sheet" & ".csv", _
FileFormat:=xlCSV, _
ConflictResolution:=2, _
Local:=True, _
CreateBackup:=False
Thanks in advance!
fileformat:=xlCSVMSDOS
Check fileformat specifications at https://msdn.microsoft.com/es-es/vba/excel-vba/articles/xlfileformat-enumeration-excel
UPDATED RIGHT NOW:
The code that works for me is:
Sub SaveTrackingSheet()
Dim NewPathTrack As String
NewPathTrack = Application.ThisWorkbook.Path & "\PDF Outputs\" & Range("NameTrack").Text & "\"
If Dir(NewPathTrack, 63) = "" Then MkDir NewPathTrack
Dim NewPathDealer As String
NewPathDealer = NewPathTrack & Range("CodeTrack").Text & " - " & Range("NameTrack").Text & "\"
If Dir(NewPathDealer, 63) = "" Then MkDir NewPathDealer
Sheets("Tracking Sheet").SaveAs _
Filename:=NewPathDealer & Range("CodeTrack").Text & " - Tracking Sheet" & ".csv", _
FileFormat:=xlCSV, _
Local:=True, _
CreateBackup:=False
'ConflictResolution:=2 This line causes the error
End Sub
Hope it helps!

application.worksheetfunction.vlookup error 1004?

i have a debug in my code, but i cannot figure out why it is happening, could you please review the code and see where i messed up? Note the error debug is happening on the ActiveCell.FormulaR1C1 line.
'ENRICHMENT CODE FOR VARIOUS TITLES
For Each wbtitle In wbrange
sThisWorkTitle = wbtitle
sThisWorkColumnNum = wbtitle.Column
sThisWorkColumnNam = Split(Cells(, sThisWorkColumnNum).Address, "$")(1)
'identifying CASH RADICAL COLUMN LETTER
If sThisWorkTitle = "Account Cash Radical" Then
scashradicalcolumnnam = Split(Cells(, sThisWorkColumnNum).Address, "$")(1)
Else
'do nothing
End If
''' CASH RELATED?
If sThisWorkTitle = "Cash Related?" Then
wbtitle.Select
Range(sThisWorkColumnNam + gspstart).Select
ActiveCell.FormulaR1C1 = Application.WorksheetFunction.VLookup(Range(scashradicalcolumnnam & ActiveCell.Row), Range(scashradicalcolumnnam & immsstart & ":" & scashradicalcolumnnam & immsfinal), 1, False)
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(gspfinal))
Columns(sThisWorkTitle).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Else
'do nothing
End If
Scott has highlighted the problem line.
You could try amending so an actual formula is inserted into the cell.
So instead of the following:
ActiveCell.FormulaR1C1 = _
Application.WorksheetFunction.VLookup( & _
Range(scashradicalcolumnnam & ActiveCell.Row) & _
, Range(scashradicalcolumnnam & immsstart & ":" & scashradicalcolumnnam & immsfinal), 1, False)
Something like:
ActiveCell = "=vlookup(" & scashradicalcolumnnam & ActiveCell.Row & _
"," & scashradicalcolumnnam & immsstart & ":" & _
scashradicalcolumnnam & immsfinal & _
", 1, False)"