Solved.
The macro loops through a table and autofills values into the destination sheet and automatically saves as a pdf on the desktop with a specified file name for each row. It does not save them into a single pdf; however, if you have adobe acrobat it has a simple merge tool to combine them together.
Sub AutoFill_export2pdf()
'
Dim rowCount As Integer
Dim CurBU As String
Dim CurOPRID As String
Dim CurName As String
Dim CurJournalID As String
Dim CurJournalDate As String
Dim FILE_NAME As String
Sheets("List").Select
rowCount = ActiveSheet.UsedRange.Rows.count
Set Destsh = ActiveWorkbook.Sheets("Sheet")
For sourceRow = 2 To rowCount
CurOPRID = Range("A" & CStr(sourceRow)) 'OPRID
CurName = Range("B" & CStr(sourceRow)) 'Name
CurBU = Range("C" & CStr(sourceRow)) 'BU
CurJournalID = Range("D" & CStr(sourceRow)) 'Journal ID
CurJournalDate = Range("E" & CStr(sourceRow)) 'Journal Date
FILE_NAME = ActiveWorkbook.Path & "\" & "OTGL_" & "JRNL_" & CurBU & "_" & CurJournalID & "_" & Format(CurJournalDate, "mm-dd-yyyy") & "_" & ".PDF"
CurName = "*" & CurName & "*"
CurBU = "*" & CurBU & "*"
CurJournalID = "*" & CurJournalID & "*"
CurJournalDate = "*" & CurJournalDate & "*"
Destsh.Range("K27") = CurName
Destsh.Range("D7") = CurBU
Destsh.Range("G7") = CurJournalID
Destsh.Range("I7") = CurJournalDate
On Error GoTo 0
Call SaveAsPDF(Destsh, FILE_NAME)
Sheets("List").Select
Next
End Sub
Public Sub SaveAsPDF(ByVal destSheet As Worksheet, ByVal PDFName As String)
On Error Resume Next
Kill PDFName
destSheet.Activate
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, filename:= _
PDFName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End Sub
Sub Autofill()
'
Dim rowCount As Integer
Dim CurBU As String
Dim CurName As String
Dim CurOPRID As String
Dim CurJournalID As String
Dim CurJournalDate As String
Dim FILE_NAME As String
CurName = "*" & CurName & "*"
CurBU = "*" & CurBU & "*"
CurJournalID = "*" & CurJournalID & "*"
CurJournalDate = "*" & CurJournalDate & "*"
Sheets("List").Select
rowCount = ActiveSheet.UsedRange.Rows.count
Set Destsh = ActiveWorkbook.Sheets("Sheet")
For sourceRow = 2 To rowCount
CurOPRID = Range("A" & CStr(sourceRow)) 'OPRID
CurName = Range("B" & CStr(sourceRow)) 'Name
CurBU = Range("C" & CStr(sourceRow)) 'BU
CurJournalID = Range("D" & CStr(sourceRow)) 'Journal ID
CurJournalDate = Range("E" & CStr(sourceRow)) 'Journal Date
FILE_NAME = ActiveWorkbook.Path & "\" & "OTGL_" & "JRNL_" & CurBU & "_" & CurJournalID & "_" & Format(CurJournalDate, "mm-dd-yyyy") & "_" & ".PDF"
Destsh.Range("K27") = CurName
Destsh.Range("D7") = CurBU
Destsh.Range("G7") = CurJournalID
Destsh.Range("I7") = CurJournalDate
On Error GoTo 0
Call SaveAsPDF(Destsh, FILE_NAME)
Sheets("List").Select
Next
End Sub
End Sub
You want to export just the Destination sheet (Destsh). So use
Destsh.ExportAsFixedFormat Type:=xlTypePDF, _
filename:="fp", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Instead of
wb.ExportAsFixedFormat Type:=xlTypePDF, _
filename:="fp", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Also this will just save the file to "fp" you want to use something like
filename:= fp & "\mysheetname.pdf"
I am trying to create the formula below using vba in excel
=SUM(COUNTIF(E7,"Vac")+ COUNTIF(E7,"LWOP")+COUNTIF(R7,"Vac")+ COUNTIF(R7,"LWOP"))
But E7 and R7 will change based on another variable called rCell.address
Below is the code that I have within the macro and it is giving an error:
Range("a8").Formula = "=SUMIF(countif(" & rCell.Address & ", "VAC"" & "))"
The current macro is:
Sub Find()
Dim strdate As String
Dim rCell As Range
Dim lReply As Long
With Worksheets("Sheet1")
strdate = .Range("a1").Value
End With
If strdate = "False" Then Exit Sub
strdate = Format(strdate, "Short Date")
On Error Resume Next
Set rCell = Cells.Find(What:=CDate(strdate), After:=Range("A1"), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
On Error GoTo 0
If rCell Is Nothing Then
lReply = MsgBox("Date cannot be found. Try Again", vbYesNo)
If lReply = vbYes Then Run "FindDate":
End If
Range("a8").Formula = "=SUMIF(countif(" & rCell.Address & ",VAC" & "))"
End Sub
I am assuming that your error appears on this line of code: Range("a8").Formula = "=SUMIF(countif(" & rCell.Address & ",VAC" & "))".
You should change that line to
Range("a8").Formula = "=SUM(COUNTIF(" & rCell.Address & "," & Chr(34) & "Vac" & Chr(34) & ")+ COUNTIF(" & rCell.Address & "," & Chr(34) & "LWOP" & Chr(34) & ")+COUNTIF(" & rCell.Offset(0, 13).Address & "," & Chr(34) & "Vac" & Chr(34) & ")+ COUNTIF(" & rCell.Offset(0, 13).Address & "," & Chr(34) & "LWOP" & Chr(34) & "))"
Updated with better answer thanks to KS Sheon
Range("a8").Formula = "=SUM(COUNTIF(" & rCell.Address & ",""Vac"")+ COUNTIF(" & rCell.Address & ",""LWOP"")+COUNTIF(" & rCell.Offset(0, 13).Address & ",""Vac"")+ COUNTIF(" & rCell.Offset(0, 13).Address & ",""LWOP""))"
SUMIF is wrong in this context.
Range("a8").Formula = "=SUMIF(countif(" & rCell.Address & ",VAC" & "))"
you should use SUMIF like this
Range("a8").Formula =SUMIF(B2:B25,">5")
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)"
I have a problem with a VBA script that I am writing to make the month end analysis of order book movements for a business where I work easier to carry out.
(I am a total a newbie, and have started learning VBA using Mr Walkenbach's 'VBA for Dummies' just to achieve this very task that I am now stuck on!)
This VBA script is part of a suite of other VBA scripts I have written to make the task easier - this is the only one I am stuck on.
I was previously carrying out this analysis using excel and just copy/pasting formulas then changing incorrect references etc to different workbooks month on month - I used the formulas from these workbooks as the basis for my VBA scripts so I know they do work in excel. I suspect there are much easier/less complex ways of achieving the same thing, but this is the limit of my ability!
The syntax error happens with the worksheet function enclosed in ** below:
Sub Despatches_Matrix()
'
' Despatches_Matrix Macro
'
Dim LastRow As Long, n As Long, LastCol As Long
Dim RowVar As Integer
Dim ColVar As Integer
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "Despatches"
Sheets("Difference").Select
Cells.Select
Selection.Copy
Sheets("Despatches").Select
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Rows("3:3").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWorkbook.Worksheets("Despatches").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Despatches").Sort.SortFields.Add Key:=Range( _
"C3:C1000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Despatches").Sort
.SetRange Range("A3:Bz1000")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
LastRow = Range("c1000").End(xlUp).Row
For n = LastRow To 3 Step -1
If Cells(n, 3).Value = 0 Then Cells(n, 3).EntireRow.Delete
Next n
LastCol = Range("Bz2").End(xlToLeft).Column - 7
'MsgBox (LastCol)
RowVar = 3
Do While Range("A" & RowVar) <> Empty
Range("D" & RowVar).Formula = "=ROUND(IF(ISNA(VLOOKUP(A" & RowVar & ",OpeningOrderBookPivot!$A$3:$B$1000,2,FALSE)),0,IF(AND(VLOOKUP(A" & RowVar & ",OpeningOrderBookPivot!$A$3:$B$1000,2,FALSE)>0,VLOOKUP(A" & RowVar & ",OpeningOrderBookPivot!$A$3:$B$41000,2,FALSE)>=-C" & RowVar & "),C" & RowVar & ",IF(AND(VLOOKUP(A" & RowVar & ",OpeningOrderBookPivot!$A$3:$B$1000,2,FALSE)>0,VLOOKUP(A" & RowVar & ",OpeningOrderBookPivot!$A$3:$B$1000,2,FALSE)<-C" & RowVar & "),-VLOOKUP(A" & RowVar & ",OpeningOrderBookPivot!$A$3:$B$1000,2,FALSE),(0)))),0)"
Range("E" & RowVar).Formula = "=ROUND(IF(ISNA(VLOOKUP(A" & RowVar & ",OpeningOrderBookPivot!$A$3:$B$1000,3,FALSE)),C" & RowVar & ",IF(AND(C" & RowVar & "<D" & RowVar & ",VLOOKUP(Despatches!A" & RowVar & ",OpeningOrderBookPivot!$A$3:$C$1000,3,FALSE)>0,VLOOKUP(A" & RowVar & ",OpeningOrderBookPivot!$A$3:$C$1000,3,FALSE)>=-(Despatches!C" & RowVar & "-Despatches!D" & RowVar & ")),C" & RowVar & "-D" & RowVar & ",IF(AND(C" & RowVar & "<D" & RowVar & ",VLOOKUP(Despatches!A" & RowVar & ",OpeningOrderBookPivot!$A$3:$C$1000,3,FALSE)>0,VLOOKUP(A" & RowVar & ",OpeningOrderBookPivot!$A$3:$C$1000,3,FALSE)<-(Despatches!C" & RowVar & "-Despatches!D" & RowVar & ")),-VLOOKUP(A" & RowVar & ",OpeningOrderBookPivot!$A$3:$C$1000,3,FALSE),0))),0)"
ColVar = 6
Do While ActiveSheet.Cells(2, ColVar) <> Empty
**Cells(RowVar, ColVar).FormulaR1C1 = "=ROUND(IF(AND(-R" & RowVar & "C3>-SUM(R" & RowVar & "C4:R" & RowVar & "C" & ColVar -1 & "),VLOOKUP(R" & RowVar & "C1,Difference!R" & RowVar & "C1:R1000C" & ColVar & ",(MATCH(R2C" & ColVar & ",Difference!R2,0)),FALSE)>0,VLOOKUP(R" & RowVar & "C1,Difference!R" & RowVar & "C1:R1000C" & ColVar & ",(MATCH(R2C" & ColVar & ",Difference!R2,0)),FALSE)>=-(Despatches!R" & RowVar & "C3-(SUM(R" & RowVar & "C4:R" & RowVar & "C" & ColVar - 1 & ")))),R" & RowVar & "C3-SUM(R" & RowVar & "C4:R" & RowVar & "C" & ColVar & " -1),IF(AND(-R" & RowVar & "C3>-SUM(R" & RowVar & "C4,R" & RowVar & ":C" & ColVar & " -1),VLOOKUP(R" & RowVar & ",Difference!R" & RowVar & "C1:R1000C" & ColVar & ",(Match(R2C" & ColVar & ",Difference!R2,0)),False)>0,-VLOOKUP(R" & RowVar & "C1,Difference!R" & RowVar & "C1:R1000C" & ColVar & ",(MATCH(R2C" & ColVar & ",Difference!R2,0)),False) _
<-(Despatches!R" & RowVar & "C3-(Sum(R" & RowVar & "C4,R" & RowVar & "C" & ColVar -1 & ")))),-VLOOKUP(R" & RowVar & "C1,Difference!R" & RowVar & "C1:R1000C" & ColVar & ",(Match(R2C" & ColVar & ",Difference!R2,0)),False),IF(VLOOKUP(Despatches!R" & RowVar & "C1,Difference!R" & RowVar & "C1:R1000C" & ColVar & ",(MATCH(R2C" & ColVar & ",Difference!R2,0)),False)=0,0,0))),0)"**
ColVar = ColVar + 1
Loop
RowVar = RowVar + 1
Loop
End Sub
At a minimum the code line you have marked with two asterisks should end with )" & _ not ) _ and the beginning of the next line should be "<-( not <-(.
Also all of your RowVar vars can be removed. In xlR1C1, if you are on the same row then RC3 and R" & RowVar & "C3 mean the same thing. It's like saying (when on row 5) C5 and C$5 and it should make no difference for your formula because you are putting then on the same row.
With ActiveSheet 'this should be better like Worksheets("Sheet1")
Do While .Cells(2, ColVar) <> Empty
.Cells(RowVar, ColVar).FormulaR1C1 = _
"=ROUND(IF(AND(-RC3>-SUM(RC4:RC" & ColVar - 1 & "),VLOOKUP(RC1,Difference!RC1:R1000C" & ColVar & ",(MATCH(R2C" & ColVar & ",Difference!R2,0)),FALSE)>0,VLOOKUP(RC1,Difference!RC1:R1000C" & ColVar & ",(MATCH(R2C" & ColVar & ",Difference!R2,0)),FALSE)>=-(Despatches!RC3-(SUM(RC4:RC" & ColVar - 1 & "))))" & _
",RC3-SUM(RC4:RC" & ColVar & " -1),IF(AND(-RC3>-SUM(RC4,R" & RowVar & ":C" & ColVar & " -1),VLOOKUP(R" & RowVar & ",Difference!RC1:R1000C" & ColVar & ",(Match(R2C" & ColVar & ",Difference!R2,0)),False)>0,-VLOOKUP(RC1,Difference!RC1:R1000C" & ColVar & ",(MATCH(R2C" & ColVar & ",Difference!R2,0)),False)" & _
"<-(Despatches!RC3-(Sum(RC4,RC" & ColVar - 1 & ")))),-VLOOKUP(RC1,Difference!RC1:R1000C" & ColVar & ",(Match(R2C" & ColVar & ",Difference!R2,0)),False),IF(VLOOKUP(Despatches!RC1,Difference!RC1:R1000C" & ColVar & ",(MATCH(R2C" & ColVar & ",Difference!R2,0)),False)=0,0,0))),0)"
ColVar = ColVar + 1
Loop
End With
Now that formula-as-a-string does compile but I cannot attest to its validity on a worksheet. One method I have used for complicated formulas is to use the ' Range.PrefixCharacter property to put the formula into the worksheet as a string.
.Cells(RowVar, ColVar).FormulaR1C1 = "'=ROUND(IF(AND(-R...
Once the routine has run through, go back to the worksheet and try and remove the ' to see if it is a valid formula and if it is returning the correct result.
Really quick question on how to format VBA in excel formulas. When you are inserting a formula into excel and you want to insert a variable from vba for example if b is a string you would use " & b & " is that the correct formatting? To illustrate the problem I have the code below and tried to use that formatting and well... I don't know why it wont work, I get a (Compile error: Expected: End of statement). Can anyone tell me where I am going wrong?
Dim HrsSTD As String
Dim HrsSAT As String
Dim HrsSUN As String
Dim HrsSTWN As String
Dim sdFormula
HrsSTD = ActiveCell.Address
Selection.Offset(0, 1).Select
HrsSAT = ActiveCell.Address
Selection.Offset(0, 1).Select
HrsSUN = ActiveCell.Address
Selection.Offset(0, 1).Select
HrsSTWN = ActiveCell.Address
sdFormula = "=IF((" & Range(NamedRange).Cells(2, 1).Address & _
"=""Please add a title"",0,VLOOKUP((" & Range(NamedRange).Cells(2, 1).Address & _
",'Tables (H)'!$H$2:$J$6,2,FALSE)* _
" & HrsSTD & "+VLOOKUP(" & Range(NamedRange).Cells(2, 1).Address & _
",'Tables (H)'!$H$2:$J$6,2,FALSE)* _
" & HrsSAT & "*1.25+VLOOKUP((" & Range(NamedRange).Cells(2, 1).Address & _
",'Tables (H)'!$H$2:$J$6,2,FALSE)*" & HrsSUN & "* _
1.5+VLOOKUP((" & Range(NamedRange).Cells(2, 1).Address & _
",'Tables (H)'!$H$2:$J$6,2,FALSE)*" & HrsSTWN & "*0.75)"
The code I would type into excel would be: But I want to change the A13's and the I16 (i.e. all the relative references) into variables in VBA
=IF(A13="Please add a title",0,VLOOKUP(A13,'Tables (H)'!$H$2:$J$6,2,FALSE)*F16+VLOOKUP(A13,'Tables (H)'!$H$2:$J$6,2,FALSE)*G16*1.25+VLOOKUP(A13,'Tables (H)'!$H$2:$J$6,2,FALSE)*H16*1.5+VLOOKUP(A13,'Tables (H)'!$H$2:$J$6,2,FALSE)*I16*0.75)
Is this what you are trying? Also I see that you haven't taken my advice from the previous answer.
One more tip. Break you code in simple parts. It is easier to understand.
The problem with your code is in the line
",'Tables (H)'!$H$2:$J$6,2,FALSE)* _
" & HrsSAT & "*1.25+VLOOKUP((" & Range(NamedRange).Cells(2, 1).Address & _
You can't write it like that. The first line doesn't have the ending ". You cannot carry it forward to the next line like that.
is this what you are trying?
Dim sFormula As String
Dim sAddr As String
sAddr = Range(NamedRange).Cells(2, 1).Address
sFormula = "=IF(" & sAddr & _
"=""Please add a title"",0,VLOOKUP(" & _
sAddr & ",'Tables (H)'!$H$2:$J$6,2,FALSE)*F16+VLOOKUP(" & _
sAddr & ",'Tables (H)'!$H$2:$J$6,2,FALSE)*G16*1.25+VLOOKUP(" & _
",'Tables (H)'!$H$2:$J$6,2,FALSE)*H16*1.5+VLOOKUP(" & _
sAddr & ",'Tables (H)'!$H$2:$J$6,2,FALSE)*I16*0.75)"