Excel VBA set print area to last row with data - excel

I have an Excel table with a sheet "CR" where columns A to K are filled, with the first row being a header row.
Rows 1-1000 are formatted (borders) and column A contains a formula to autonumber the rows when data in column F is entered.
Sheet "CR" is protected to prevent users from entering data in column A (locked).
Using the Workbook_BeforePrint function, I'm trying to set the print area to columns A to K and to the last row of column A that contains a number.
My code (in object 'ThisWorkbook') is as follows:
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim ws As Worksheet
Dim lastRow As Long
Set ws = ThisWorkbook.Sheets("CR")
' find the last row with data in column A
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
ws.PageSetup.PrintArea = ws.Range("A1:K" & lastRow).Address
End Sub
However, when I click File -> Print, the range of columns A to K up to row 1000 is displayed instead of only the rows that have a number in column A. What am I doing wrong?

Change:
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
To:
lastRow = [LOOKUP(2,1/(A1:A65536<>""),ROW(A1:A65536))]

.End(...) will act like ctrl + arrow-key. if the cell has a formula (which looks empty due to the formula, then it will still stop there... another way would be the use of evaluate (if you do not want to loop) like this:
lastRow = .Evaluate("MAX(IFERROR(MATCH(1E+100,A:A,1),0),IFERROR(MATCH(""zzz"",A:A,1),0))")
This will give the last row (which has a value in column A).
Also check if there are hidden values (looking empty due number format or having characters you can't see directly. Try to go below row 1000 in column A (select a cell after A1000 in column A) and hit ctrl+up to validate where it stops (and why).
EDIT:
(regarding your comment)
"" still leads to a "stop" for the .End(...)-command. So either use my formula, translate the formula into vba or loop the cells it get the last value. Also Find is a good tool (if not doing it over and over for countless times).
lastRow = .Cells.Find("*", .Range("B1"), xlValues, , xlByColumns, xlPrevious).Row

Related

Replicating values

Need a little help here.
In the "Data" Tab I want to copy values in column "c2:c1000" and paste in column "a1" of another Tab.
This is what i have so far,
Dim x As Long
Dim lastRow As Long
lastRow = Worksheet("Data").Cells(3, Columns.Count).End(xlUp).Column
For x = 1 To lastRow
If Worksheets("Sheet2").Cells(2, "A") = "" Then
Worksheets("Data").Range("c2:c1000").Copy Destination:=Worksheets("Sheet2").Range(1, "A")
Sheets("Sheet2").Range("A1").Value = Format(Now, "mm/dd/yyyy HH:mm:ss")
Else
Worksheets("Data").Range("c2:c1000").Copy Destination:=Worksheets("Sheet2").Cells(2,
Columns.Count).End(xlToLeft).Offset(, 1)
'Sheets("Sheet2").Range("A1").Value = Format(Now, "mm/dd/yyyy HH:mm:ss") --> can't figure how to increment this as this will need to be on the subsequent empty column
End If
Next
End Sub
Your help will be greatly appreciated!
Thank you.
Pasting values first into range A1 and down and then next time to cell B1 and so on, leaves no space for the timestamp to A1, B1 etc. So, I assume that you would like to paste the random values to row 2. So cells A1, B1, ... are left for the timestamp.
Inside the With statements we can refer to properties of the wsAudit so we can replace the "Worksheets("Audit")." reference with just "."
The column.count expression just checks the amount of columns in the worksheet.
The expression .Cells(2, Columns.Count) just points to last cell in the row 2.
The .End(xlToLeft).Column then looks from this column to left and is supposed to find the last not empty cell on this row. It's basically the same idea that in Excel's sheet you would go to cell XDF2 and hit CTRL+Arrow Left from keyboard.
But instead of activating the cell we just want to get the columns index number and then add 1 (the new column) and save it into variable. Now the new column is known.
The expression Range(.Cells(2, newColAudit), .Cells(1000, newColAudit)).Value is really the same as e.g. Range("B2:B1000"), but with this we can use the row and column index numbers instead. This is useful as the column number varies.
And as Samuel pointed out the copy paste operation can be avoided by setting the areas equal.
Dim wsAudit As Worksheet
Dim newColAudit As Long
Set wsAudit = Worksheets("Audit")
With wsAudit
newColAudit = .Cells(2, Columns.Count).End(xlToLeft).Column + 1
Range(.Cells(2, newColAudit), .Cells(1000, newColAudit)).Value = Worksheets("Data").Range("C2:C1000").Value
.Cells(1, newColAudit).Value = Format(Now, "mm/dd/yyyy HH:mm:ss")
End With
Much like your LastRow* variable for your source sheet, create a LastColumn variable for your destination sheet, which will find the last used column the same way you are finding your last used row.
Like so:
Dim LastColumn As Long
LastColumn = Sheets("Audit").Cells(1, Columns.Count).End(xlToLeft).Column
Then use the variable like so:
Destination:= Worksheets("Audit").Cells(1, LastColumn)
It seems that your code contradicts your question too, in your question you explained the data will be written to the Audit sheet in row 1, using the next column each time but your code looks for values in row 2 in your If statement:
If Worksheets("Audit").Cells(2, "A") = "" Then is the same as If Worksheets("Audit").Range("A2") = "" Then.
If you mean to check the first row, change the 2 to 1.
To help improve your codes efficiency:
(Also see the link to 'how to avoid select' in that question):
You can achieve 'copy/paste' without actually using the 'copy' and 'paste' methods by assigning the value of one range to the other, as example, like so:
Worksheets("Audit").Cells(1, LastColumn).Resize(999, 1) = Worksheets("Data").Range("c2:c1000").Value
Note: Change the Resize Property rows to suit the source range (in this case you are wanting to move values from C2:C1000).
*The LastRow variable is a bit confusing, as it is looking for the last used column in row 3.
If it's meant to find a column, consider renaming it to avoid confusion later on in debugging.
If it's meant to find the last row, try like this:
LastRow = Worksheet("Data").Cells(Rows.Count, 1).End(xlUp).Row

Sorting places my data with empty cells above it

I have written a bunch of VBA macros to get my data formatted how I need it, and the last step is to sort by this new column I have generated in ascending order. However, when I hit sort by the new column, the code now places all the empty cells above my newly generated column as I think it is reading the empty as a 0 and sorts it above any alphanumeric data. This is happening because of the UDF I have for sorting the data. I need to insert the new column with the UDF for each new cell that I insert, but I don't know how to define the range in the new column.
I am close to solving this but would love some help.
Essentially what I have tried for placing the data in a new column works, but the way I have set the range is placing it in a bad spot and it can easily be sorted in the wrong order now. I include all of my code, but the issue is in the last portion of it where I am setting a range to place the new data.
I think what is happening is when I set my range from C3-C2000 and populate it, the remaining empty cells are now included in my sort and give me "lower" numbers when I sort it ascending. Thus all the empty cells are ranked higher up in the column.
Option Explicit
Sub ContractilityData()
Dim varMyItem As Variant
Dim lngMyOffset As Long, _
lngStartRow As Long, _
lngEndRow As Long
Dim strMyCol As String
Dim rngCell As Range
Columns("B:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 'make new column for the data to go
lngStartRow = 3 'Starting row number for the data. Change to suit
strMyCol = "A" 'Column containing the data. Change to suit.
Application.ScreenUpdating = False
For Each rngCell In Range(strMyCol & lngStartRow & ":" & strMyCol & Cells(Rows.Count, strMyCol).End(xlUp).Row)
lngMyOffset = 0
For Each varMyItem In Split(rngCell.Value, "_") 'put delimiter you want in ""
If lngMyOffset = 2 Then 'Picks which chunk you want printed out (each chunk is set by a _ currently)
rngCell.Offset(0, 1).Value = varMyItem
End If
lngMyOffset = lngMyOffset + 1
Next varMyItem
Next rngCell
Application.ScreenUpdating = True
'Here is where my problem arises
Range("C:C").EntireColumn.Insert
Dim sel As Range
Set sel = Range("C3:C2000")
sel.Formula = "=PadNums(B3,3)"
MsgBox "Data Cleaned"
End Sub
What I would like instead is a way to insert a new column, then have my UDF "PadNums" populate each cell up to the last cell of the previous column, essentially re-naming all my data from the previous column. I can then sort by the new column in ascending order and my data is in the correct order.
I think perhaps what I should do is copy column B into my newly inserted column C, then use some sort of last row function to apply the formula in all cells. That would give me the appropriate range always based on my original column?
I solved this! What I did was use range and xlDown to last row on column B, then pasted it to C, then inserted my UDF into C using the xlDown range!

Incremental Numbering while skipping over certain cells

I am trying to do an incremental numbering in Excel, but for a specific condition. If the condition does not match, then it should keep the existing cell details.
Image:
As you can see from the picture, I want to create a numbering list in column B, which is based off information shown in the corresponding row in column D. So on the second row, I would the counting to start at "1" and then continue to expand only as the count of "is_null" and "equal" grows. At the same time, I want it to skip over the green and blue cells and keep the contents as is.
As of right now, I have done the following formula:
=COUNTIF($D$1:D2,"is_null")+COUNTIF($D$1:D2,"equals")
This does the proper numbering, however it over-writes the green and blue cells instead of keeping them as "A" and "stop" respectively.
If someone can help me with that issue, then I should be good to go. Thanks!
I'm not sure what the value should be if in Column D you find the String "set_path" or "stop", but if these are always the same (i.e. "a" if Column D = "set_path" and "stop" if Column D = "stop"), you could achieve your desired results with the following formula:
=IF(AND(D2<>"set_path",D2<>"stop"),COUNTIF($D$1:D2,"is_null")+COUNTIF($D$1:D2,"equals"),IF(D2="set_path","a",IF(D2="stop","stop","")))
UPDATE:
Using VBA you could leave the contents of the cell as they are without overwriting them with a formula using the code below:
Sub foo()
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
'declare and set the worksheet you are working with, amend as required.
Dim LastRow As Long, i As Long
LastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
'get the last row with data on Column D
For i = 2 To LastRow
If ws.Cells(i, "B").Value = "" Then 'if cell is empty add formula
ws.Cells(i, "B").FormulaR1C1 = "=COUNTIF(R1C4:RC[2],""is_null"")+COUNTIF(R1C4:RC[2],""equals"")"
End If
Next i
End Sub
Second Update:
I've now adapted the formula to increment the letters by one if "set_path" is found in Column D (Please bear in mind that this will go from A-Z and then it will start going through symbols as per ASCII table, so you might have to amend this if you want alternate behavior):
=IF(AND(D2<>"set_path",D2<>"stop"),COUNTIF($D$1:D2,"is_null")+COUNTIF($D$1:D2,"equals"),IF(D2="set_path",IFERROR(CHAR(COUNTIF($D$2:D2,"set_path")+64),""),IF(D2="stop","stop","")))

Worksheet.UsedRange.Rows.Count returns wrong result

In VB.NET I want to get the used rows so I wrote that:
Dim objWorksheet As Excel.Worksheet = workbook.Sheets(2)
Dim lastRow = objWorksheet.UsedRange.Rows.Count
The number of lastRow is less than used rows. I searched the site and someone suggested:
Dim range As Excel.Range = objWorkSheet.UsedRange
Dim lastRow = range.Rows.Count
This returns less than actual used rows.
The solution is in the image:
I found this question it is an overall understanding of the last used row.
UsedRange.Rows.Count means from the first rows that has data to the last rows that has data, which means you can have empty rows between the first non-empty rows to the last non-empty rows which not affect the result, but if the first row is empty, the result will be one less the actual non-empty row, and if the first two row is empty the result will be two less, so the link question said never use UsedRange.Rows.Count to get the last row.
Try to avoid UsedRange. It can be misleading. For instance, if you fill range A1:B5 and clear the contents of column B, then UsedRange.Columns.Count will return 2 - because Excel remembers cells with formatting and includes them into UsedRange.
UPDATE
To get real last column and row, use following code:
lRealLastRow = _
Cells.Find("*", Range("A1"), xlFormulas, , xlByRows, xlPrevious).Row
lRealLastColumn = _
Cells.Find("*", Range("A1"), xlFormulas, , xlByColumns, xlPrevious).Column
UPDATE 2
Sometimes it only appears too small. Say we have:
and we run:
Sub aRowsByAnyOtherName1()
Dim N As Long
N = ActiveSheet.UsedRange.Rows.Count
MsgBox N
End Sub
We see:
The reason we get 3 rather than 4 is that the top row of the worksheet is not in UsedRange!
EDIT#1:
If the "top" of the worksheet needs to be included then use:
Sub aRowsByAnyOtherName2()
Dim N As Long, rng As Range
Set rng = ActiveSheet.UsedRange
N = rng.Rows.Count + rng(1).Row - 1
MsgBox N
End Sub
This is a bit of a punt on what you mean by "used" rows. If you have any blank rows at the start of the sheet you will get the wrong last row number but you will get the used range row count.
Try the following with row 1 blank.
Option Explicit
Sub test()
Dim rng As Range
Set rng = ActiveSheet.UsedRange
Debug.Print rng.Rows.Count '2
Debug.Print ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row '3
End Sub
This yields 2 from UsedRange.Rows.Count and 3 from using xlCellTypeLastCell with data as below:
I'm using Excel 2013, and as far as I can see the UsedRange and UsedRange.Count Properties work correctly
In previous versions I can remember noticing that they were unreliable, and I think this may be the reasons of some older posts, eg stackoverflow.com/questions/11169445...
Note that the UsedRange is a Single Rectangular Area bounded by the Top-, Right-, Bottom-, and Left-most
Non-Blank Cells, so that the Last Used Row is thus
ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1
Note also that UsedRange INCLUDES all Cells that have Any Content, for example a Border, Interior Coloring or a Comment, not just those with a Value or a Formula
Depending on what you are trying to achieve, using the SpecialCells and Find Methods may be preferable; for example the Last Used Row can also be found using
ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
UsedRange does exactly what it is supposed to do in these scenarios. How many rows of data do you have? If you have a block of data in the center of a worksheet with 3 rows and 4 columns, UsedRange returns 3 rows properly. If your worksheet has empty rows in rows 1:3, for example, you must consciously make note of that. UsedRange is very powerful if you format your workbook properly, and even MORE powerful when it's not formatted like that, because it doesn't care where the table is.
As a best practice, you should always have a single, continuous table of data on a spreadsheet starting in cell A1. If you need a summary formatted a few rows and columns in, that should be a separate sheet. And if you get a worksheet from another source that isn't formatted properly, it's your job to fix that before you analyze it -- delete empty rows and columns in front of the table.

Macro to insert blank cells below if value >1 and copy/paste values from cell above

This site already has something similar: Copy and insert rows based off of values in a column
but the code doesn't take me quite where I need to go, and I haven't been able to tweak it to make it work for me.
My user has a worksheet with 4 columns, A-D. Column A contains specific contract numbers, column B is blank, column C has part numbers, and column D has the entire range of contract numbers. My user wants to count the number of times the entire range contract numbers has duplicates so I entered the formula =countif($D$2:$D$100000,A2) in cell E2 and copied down, giving me the number of times the specific contract in column A appears in column D. The numbers range from 1 to 11 in this workbook but the number may be higher in other workbooks this method will be used in.
The next thing I need to do is to enter blank cells below all values in column E that are greater than 1, very much like the example in the previously asked question. I then also need to copy in the same row and insert copied cells exactly to match in the same row in column A. Example: Cell E21 has the number 5 so I need to shift cells in column E only so that there are 4 blanks cells directly below it. In column A, I need to copy cell A21 and insert copied cells in four rows directly below.
Just trying to get the blank cells to insert has been a trial, using the code as given in the previous question.
Dim sh As Worksheet
Dim lo As ListObject
Dim rColumn As Range
Dim i As Long
Dim rws As Long
Set sh = ActiveSheet
Set lo = sh.ListObjects("Count")
Set rColumn = lo.ListColumns("Count").DataBodyRange
vTable = rColumn.Value
For i = rColumn.Rows.Count To 1 Step -1
If rColumn.Cells(i, 1) > 1 Then
rws = rColumn.Cells(i, 1) - 1
With rColumn.Rows(i)
.Offset(1, 0).Resize(rws, 1).Cells.Insert
.EntireRow.Copy .Offset(1, 0).Resize(rws, 1).Cells
.Offset(1, 0).Resize(rws, 1).EntireRow.Font.Strikethrough = True
End With
End If
Next
I would be very grateful for any help as I have been fighting with this monster for a week.
While this is indeed possible to do, it might be a good idea to look into moving the list of all contract numbers from column D to a different sheet. Even though it is quite simple to loop through a range and insert rows based on cell values - it'll also create holes in columns D and E.
Here's code for simply adding the rows and copying the values as you specified.
Sub Main()
'---Variables---
Dim source As Worksheet
Dim startRow As Integer
Dim num As Integer
Dim val As String
Dim i As Long
'---Customize---
Set source = ThisWorkbook.Sheets(1) 'The sheet with the data
startRow = 2 'The first row containing data
'---Logic---
i = startRow 'i acts as a row counter
Do While i <= source.Range("E" & source.Rows.Count).End(xlUp).Row
'looping until we hit the last row with a value in column E
num = source.Range("E" & i).Value 'Get number of appearances
val = source.Range("A" & i).Value 'Get the value
If num > 1 Then 'Number of appearances > 1
Do While num > 1 'Create rows
source.Range("A" & i + 1).EntireRow.Insert 'Insert row
source.Range("A" & i + 1) = val 'Set value
num = num - 1
i = i + 1 'Next row
Loop
End If
i = i + 1 'Next row
Loop
End Sub
Of course you could also remove the holes from column D after inserting the new rows and modify the formula in column E so that it remains copyable and doesn't calculate for the copied rows.
Generally it makes things easier if a single row can be thought of as a single object, as creating or deleting a row only affects that one single object. Here we have one row represent both a specific contract and a contract in the all contracts list - this could end up causing trouble later on (or it could be totally fine!)

Resources