Excel Macro - Dynamically Set Print Area - excel

I have a table with a fixed number of columns, but the number of rows vary week on week.
Is there a macro I can create to set the print area automatically of this table?

I would combine a dynamically resizing named range with a VBA method.
First create a named range, MyNamedRange: (Assuming your table begins at $A$1 and your table has headers)
=OFFSET(A1,0,0,COUNTA(A:A)-1,COUNTA(1:1))
Then just execute a line of VBA:
ActiveSheet.PageSetup.PrintArea = "MyNamedRange"

Just use this simple code:
Private Sub prnt()
On Error Resume Next
Cells(1, 1).Select
With ActiveSheet.PageSetup
.PrintArea = Range(ActiveCell, ActiveCell.SpecialCells(xlCellTypeLastCell)).Select.Address
.Orientation = xlLandscape
.LeftHeader = "&p/&N"
.LeftFooter = ActiveWorkbook.FullName 'to show address
.PrintTitleRows = "$1:$5" 'repeat at top
.Zoom = False
.Orientation = xlLandscape
.FitToPagesWide = 1 'to print in 01 page
.FitToPagesTall = False 'to print in 01 page
End With
End Sub

If you're wanting to print the whole sheet always, you can actually just clear the print area and it will default to the amount of the sheet that is filled with data. If you're wanting not to hide some columns, wtfsven's answer is perfect.

I guess this is a pretty late response...
The solution above didn't work for me in Excel 2007 so I used
begin_column = 1
end_column = 5
begin_row = 1
end_row = 30
'converting the numbers to uppercase letters
temp_begin_column = Chr(first_column + 64)
temp_end_column = Chr(second_column + 64)
ActiveSheet.PageSetup.PrintArea = "$" & temp_begin_column & "$" & begin_row & ":$" & temp_end_column & "$" & end_row
This may seem like a complicated solution but its the only thing that reliably worked for me

I have tried this and it Worked for me.
StartColumn="A"
StartRow=1
EndColumn="B"
EndRow=10
ActiveSheet.PageSetup.PrintArea = StartColumn & StartRow & ":" & EndColumn & EndRow
ActiveSheet.PageSetup.PrintArea = "A1:B10"
Or
ActiveSheet.PageSetup.PrintArea = "$" & StartColumn & "$" & StartRow & ":" & "$" & EndColumn & "$" & EndRow
ActiveSheet.PageSetup.PrintArea = "$A$1:$B$10"

ActiveSheet.PageSetup.PrintArea = "MyNamedRange" as proposed above by Stephen Collins does not work for me.
But if I typed a slightly modified version:
ActiveSheet.PageSetup.PrintArea = MyNamedRange.Address then it works perfectly in my context.
I had Application.ReferenceStyle = xlR1C1 activated and not xlA1.
Note: ActiveSheet.PageSetup.PrintArea = MyNamedRange.Address(ReferenceStyle:=xlR1C1) would not work for me.
Similarly,
ActiveSheet.PageSetup.PrintArea = StartColumn & StartRow & ":" & EndColumn & EndRow as proposed above by Bhanu Pratap works indeed very well, 1st time. Bu not so easy to manage programmatically (column letters).
But using "R" & StartRow & "C" & StartColumn & ":" & "R" & EndRow & "C" & EndColumn --- does not work for me either. So, consistent.
Looking at https://learn.microsoft.com/en-us/office/vba/api/excel.pagesetup.printarea
it states that "you use the Address property to return an A1-style address."
So, it seems to be an expected VBA behaviour not to use xlR1C1 while it would be much easier to use programmatically.
My simple way around it:
Set MyNamedRange = Worksheets(i_sheet_idx).Range(Cells(StartRow, StartColumn), Cells(EndRow, EndColumn)) -- using the same variables as suggested above by Bhanu Pratap.
Then
ActiveSheet.PageSetup.PrintArea = MyNameRange.Address ' which does the job for me.
So, I can programmatically play with the start/End Row/Columns easily.
Using offset as suggested above should work also to change the range but this is independent from the programmatic difficulty encountered here in VBA to specify the range address in a way VBA would accept to swallow without error. I would not want to count the strange & unclear VBA errors I had on these trials. I don't use VBA often & never program otherwise (hence the struggle above). The goal was to print automatically, smartly & recurrently a large number of parts of a large worksheet following a pattern.
NB: possibly unrelated, I encountered in the debugging phase - just on the PageSetup.PrintArea line - as above a strange phenomenon where even if no error (so the code following later after rerun a fully expected & controlled path), my code would jump - sometimes - to a totally different sub or function in another workbook without reason (I have another personal workbook storing a number of work macros in several modules). It happens 4 times in tests. I tried to find events that could trigger this but could not find one. Sometimes it was the same sub/function being triggered, sometimes it was a different one, with no logical connection. But I noted that I had seen the same function being triggered in another situation before (see its basic code below), without good reason. So, something must happen at application level. In this "short piece of code" just written to test the above, I introduced later an error handler to catch err.number in case a problem would occur but of course, it did not reoccur.
I suppose that closing & restarting Excel (2013 here) should fix this error. This has happened to me before once in Excel 2010. A pointer going nuts but with some insistence, a repeated folly which supposes some logic behind. Weird.
Here is the function most often triggered in another module in another workbook (while not being programmatically activated at all, I repeat): it does not make logical sense to me but so it is:
Function HLink(rng As Range) As String
'extract URL from hyperlink
If rng(1).Hyperlinks.Count Then HLink = rng.Hyperlinks(1).Address
End Function
The other sub being activated did not make more apparent sense.

Related

Count IF on multiple sheets, VBA

If Application.CountIf(Sheet5.Range("A:A"), TextBox1.Value) = 0 Then
GoTo 10
Else....
This code checks if there is already a value from Textbox1 somewhere in A column(a list of values).
Now I want to transform the code so it checks existence of a value(from textbox1) in multiple sheets(growing), but only in one cell from every sheet(say: A1).
Can this be done with count if somehow? I dont want to use Loops (for, with..) takes to long on few hundreds of sheets
See the below:
For Each ws In ThisWorkbook.Worksheets
formula = formula & "," & ws.Name & "!A1"
Next ws
formula = "=COUNTIF({" & Mid(formula, 2) & "}, TextBox1.Value)"
If Application.Evaluate(formula) = 0 Then
GoTo 10
Else....
Without looping (and the use of ms365's TOCOL()), you could use 3D-referencing. But make sure your range of worksheets are connected. For example:
Debug.Print Application.Evaluate("SUM(N(TOCOL(Sheet1:Sheet100!A1,3)=" & TextBox1.Value & "))")
This is very much so like this older post, but TOCOL() makes life easier, plus you won't run into the limits of the Evaluate() method.
Note that if you have a growing number of sheets, you could also opt for:
Debug.Print Application.Evaluate("SUM(N(TOCOL(Sheet1:Sheet" & Application.Sheets.Count & "!A1,3)=" & TextBox1.Value & "))")

Need macro to write the formula in a cell not the answer (ouput)

I cannot figure this out - I either get a Named? error or Application defined error on trying everything.
Dim sAmt As Integer
Dim sOriginalAmount As Integer
sOriginalAmount = ActiveCell.Value
sAmt = Application.InputBox("How much additional cost?", Type:=2)
ActiveCell.Formula = sOriginalAmount + sAmt
What I want Excel to do is write the formula in the cell not the output.
For example - Currently if I have sOriginalAmount as 15 and I enter sAmt as 20, on running the code, it gives the answer 35 in the cell, but I want it to write =sum(valueofsOriginalAmount + valueofsAmt) so that at a later time I can see what was the original amount and how much was added.
Can anyone please help? I have tried & "" in various combinations but I just can't get it. Apologies for such a noobie question, but I am self learned and I code for my work only.
This should work.
ActiveCell.Formula = "=" & sOriginalAmount & "+" & sAmt
Or if you actually want to use SUM.
ActiveCell.Formula = "=SUM(" & sOriginalAmount & "," & sAmt & ")"

How do I prevent an excel table's formatting from overwriting a range's existing formatting in VBA?

I'm working with a spreadsheet that requires the use of a table. I resize it to only include the headers and the first line of data I'm working with, but when I then refit it to cover all of my existing data, it overwrites the formatting and resets the color back to default white. I need these colors as they are referenced later in the code. Is there a way to prevent the table from doing this?
Dim FLF As Worksheet
Set FLF = Workbook("My Workbook").Sheets("FLF")
Dim x As Long
Dim lng As Long
With FLF
FLF.Activate
.ListObjects("Table1").Resize Range("$A$6:$K$7")
lng = .Cells(.Rows.count, "D").End(xlUp).Row
.Range("E7:G" & lng).NumberFormat = "0.00%"
.ListObjects("Table1").Resize Range("$A$6:$K$" & lng)
For x = 7 To lng
If .Range("A" & x).Interior.ColorIndex = 46 Then
TopPercent = .Range("K" & x).Value
Do
x = x + 1
.Range("K" & x) = TopPercent * .Range("F" & x).Value
.Range("K" & x).Font.FontStyle = "Italic"
Loop While .Range("A" & x + 1).Interior.ColorIndex = 36
End If
Next x
I tried to recreate the thing you are describing. I think I'm missunderstanding whats happening.
I made a table, put some data below the table, colored the cells yellow and then dragged that little blue thing in the bottom right down over my yellow data to include it in the table. For me it keeps the formatting.
The only thing I can think of, is that you manually applied some form of filling to the table? You could change the table style and formatting. If you want to keep your table, the only thing I can think of is to save the colorindex of the important range before expanding the table and then reformatting that range after you have expanded it. This could be done in several ways but since we are already in VBA, how about this?
'I don't know how to Dim this in one line, sorry
Dim ColorIndexArray()
ReDim ColorIndexArray(ThisWorkbook.Sheets("FLF").Cells(ThisWorkbook.Sheets("FLF").Rows.Count, "A").End(xlUp).Row)
For i = 1 To ThisWorkbook.Sheets("FLF").Cells(ThisWorkbook.Sheets("FLF").Rows.Count, "A").End(xlUp).Row
ColorIndexArray(i) = ThisWorkbook.Sheets("FLF").Range("A" & i).Interior.ColorIndex
Next
'Do your stuff
For i = 1 To ThisWorkbook.Sheets("FLF").Cells(ThisWorkbook.Sheets("FLF").Rows.Count, "A").End(xlUp).Row
ThisWorkbook.Sheets("FLF").Range("A" & i).Interior.ColorIndex = ColorIndexArray(i)
Next
Edit: I tried loading all indices into the array at once and failed, hence the loop. Also, if you have tens or hundreds of thousands of rows, and you already have an array now, you could do your calculations on it instead to speed things up? But if its only a couple lines it shouldnt matter.

Macro to Find and Replace Field Names

I need to find and replace hundreds of misnamed field names (cell names) in a large excel financial model. I'm trying to build this macro subroutine to find a given field name and replace it with the correct field name.
Sub FindReplaceFieldName()
Dim orgFieldName As String
Dim replFieldName As String
orgFieldName = "CAN"
replFieldName = "Canada"
Application.Goto Reference:=orgFieldName
With ActiveWorkbook.names(orgFieldName)
.Name = replFieldName
.RefersToR1C1 = "=Sheet1!(" & activeCell.row & ";" & activeCell.Column &")".Comment = ""
End With
ActiveWorkbook.Save
End Sub
The field name is found and replaced, but a Runtime error 1004 is thrown here
"=Sheet1!(" & activeCell.row & ";" & activeCell.Column &
")"
"The formula you typed contains an error." and so on.
I'm not familiar with VBA syntax, so a 2nd pair of experienced eyes would be helpful.
SOLVED: The correct syntax should be
.RefersToR1C1 = "=Sheet1!R" & activeCell.row & "C" & activeCell.Column & ""
Forgive me if wrong, but are you not approaching this sideways? You want to change the existing names not amend the locations; Ergo, use a mapping to rename the existing.
For example, use a dictionary to rename (you could use other structures); I wanted to leverage the .Exists of a dictionary so only attempted valid substitutions. You could even loop a range in the sheet to populate your dictionary. Or read the range straight into an array and dump the array into the dictionary as key/values.
Code:
Option Explicit
Public Sub RenameNamedRanges()
Dim currName As Name
Dim replaceDict As Object
Set replaceDict = CreateObject("Scripting.Dictionary")
replaceDict.Add "CAN", "Canada"
replaceDict.Add "FR", "France"
replaceDict.Add "DE", "Deutschland"
For Each currName In ThisWorkbook.Names
If replaceDict.Exists(currName.Name) Then
currName.Name = replaceDict(currName.Name)
End If
Next currName
End Sub
Before:
After:
To troubleshoot issues like this, where you're building a string to be used elsewhere, troubleshoot by looking at the problem string just before the error is caused.
In this case, you could add a line just before the line where you get the error:
Debug.Print "=Sheet1!(" & activeCell.row & ";" & activeCell.Column & ")"
...then, when you run your code and get the error, go to the Immediate Window (Ctrl+G) and see what Excel thinks you mean.
Are you able to see your error now?
That being said, you must have posted your code incorrectly, since I can't get it to run at all (to get an Error 1004) since this line is wonky:
.RefersToR1C1 = "=Sheet1!(" & activeCell.row & ";" & activeCell.Column &")".Comment = ""
If I replace the row and column numbers you're trying to insert with 1234 then it would read:
.RefersToR1C1 = "=Sheet1!(1234;1234)".Comment = ""
I can't give an absolute solution without knowing more about what you're trying to do, but obviously that is an invalid command (and likely not what you intended).
Note that ActiveCell.Row and ActiveCell.Column both return numbers, and that Sheet1!(1,1) is not how we refer to a cell in Excel.

Run time error 1004 - MS Office excel can not create or use the data range because it is too complex

I am trying to write a code for filtering data with particular criteria and selecting filtered data, copy and pasting visible cells only in different sheet. However, I am getting error "Run time error 1004" stating MS Office excel can not create or use the data range because it is too complex.
enter image description here
below is the code that I am using
Set mwb = ActiveWorkbook
fname = ActiveWorkbook.Name
pth = path
period = Sheets("DEF").Range("F18").Value
ddate = Range("L6").Value
Sheets("MacroTOSplit").Select
blr = Range("C50").End(xlUp).Row
Rcfield = Range("C1").Value
For a = 4 To blr Step 1
Sheets("MacroTOSplit").Select
If Cells(a, "C").Value <> "" Then
rc1 = Cells(a, "C").Value
Sheets("XYZ").Select
Cells.AutoFilter
If lr >= 2 Then
Range("B2:B" & lr + 1).EntireRow.Delete
End If
Sheets("ABC").Select
dlr = lr
Set datarange = Sheets("ABC").Range(Cells(1, 1), Cells(dlr, "BG"))
'Filter for each unit and copy the data
datarange.AutoFilter Field:=Rcfield, Criteria1:=rc1, Operator:=xlFilterValues
datarange.Range(Cells(2, 1), Cells(dlr, "BG")).SpecialCells(xlCellTypeVisible).Copy Sheets("XYZ").Range("A2")
I am getting error at last step.
Please provide some solution for this.
Thanks,
Ravi
Try adjusting the last line to say:
datarange.Range(Cells(2, 1).address & ":" & Cells(dlr, "BG").address)
I think that you are out of luck if you get the range too complex message.
However, if it is possible, you could pre-sort your data so that the selection is in fewer non-contiguous blocks. This would make the selection less complex.

Resources