I am trying to define the print area for the active sheet that would include all rows in columns A thru X.
The number of rows changes with each active sheet.
This gives me a runtime error and thinks I'm trying to write a formula.
Sub setprintarea()
' Sets Range from cell A1 for all rows thru column 24 (X)
ActiveSheet.PageSetup.PrintArea = "$A$1:$X$"
End Sub
You have a minor syntax error. To specify full columns, you will want to specify "$A:$X". This may give the impression that you will print the entirety of columns A through X. However, that is not the case. Excel will print only enough sheets as needed for cells containing content.
As an example, create a new worksheet. On the worksheet, enter values in random cells in columns A through C. Next, set the print area to $A:$B. Now, do a print preview. You will see that Excel is smart enough to only create pages where data exists.
Corrected code:
ActiveSheet.PageSetup.PrintArea = "$A:$X"
It is true that the OP probably doesn't want the range to extend to the last row on the sheet. It is also possible that X is not the longest column on the sheet, in which case you would want to test each column to determine the sheet length. Hope this doesn't overcomplicate the matter, but sometimes the last column isn't the sheet length.
MaxLastRow = 1
For x = 1 To 24
If ActiveSheet.Cells(Rows.Count, x).End(xlUp).Row > MaxLastRow Then
MaxLastRow = ActiveSheet.Cells(Rows.Count, x).End(xlUp).Row
End If
Next x
ActiveSheet.PageSetup.PrintArea = "$A$1:$X$" & MaxLastRow
Dynamic Print Area
Sub setPrintArea()
With ActiveSheet
.PageSetup.PrintArea = Intersect(.UsedRange, .Columns("A:X")).Address
' Write the address to the Immediate window (CTRL+G).
Debug.Print .PageSetup.PrintArea
End With
End Sub
Related
Yesterday I learned here how to copy a row to a second sheet.
Sub maJolieProcedure(Texte As String)
With Worksheets("employes").Range("A:A")
Set c = .Find(what:=Texte)
If Not c Is Nothing Then
firstAddress = c.Row
Worksheets("employes").Rows(firstAddress).Copy _
Destination:=Worksheets("rapport").Range("A1")
MsgBox "Ok"
Else
MsgBox "Nok"
End If
End With
End Sub
To respect the formatting of the second sheet, I want to copy and paste the contents of each cell one by one.
I can identify the line number. However, I can't figure out how the Range object can return each cell one by one. For example, C3 content if Rows = 3.
Thanks a lot.
If you don't want to paste the formatting from one range to another paste values only.
Worksheets("employes").Rows(firstAddress).Copy
Worksheets("rapport").Range("A1").PasteSpecial xlValues
That's the same for all ranges, whether 1 cell or a million. The Copy process copies the subject to memory as one block. Any parsing must be done before the Copy instruction. An alternative is to read a range into an array.
Dim Arr As Variant
Arr = Worksheets("employes").Rows(firstAddress).Value
This will create a 3D array of 1 row and about 16000 columns. You might decide to limit your enthusiasm to only what you need.
With Worksheets("employees")
Arr = .Range(.Cells(firstAddress, 1), .Cells(firstAddress, .Columns.Count).End)xlToLeft)).Value
End With
Pay attention to the leading periods within the With statement. Each such period stands for the object mentioned in the With statement.
If your goal is to respect the formating of the second sheet, you don't need to loose time copying cell by cell.
It is more effective to do a paste special, like you do with the mouse:
Range("A1").Copy
Range("B1").PasteSpecial Paste:=xlPasteValues
works very well also with bigger ranges if you need:
Range("A1:A12").Copy
Range("B1:B12").PasteSpecial Paste:=xlPasteValues
or even
Range("A1:A12").Copy
Range("D3").PasteSpecial Paste:=xlPasteValues
If your goal is to really access all cell of a range individually , you just iterate on the range. For example:
For Each cell In Range("A1:A12")
cell.Value = cell.Value + 2
Next cell
I would like to find a way how to cycle through merged cells, e.g. using a For...Next loop.
I could only manage to make it work like this:
Cells(1,1).Select
For i=1 to 6
Selection.Value = arrData(i)
Selection.Offset(0,1).Select
Next i
I hate using .Select - but if I use .Offset(0,i) it won't move from merged cell to merged cell, but just the number of columns from the original cell.
For more detail - I am copying values from a csv-like format into a nicer formatted output sheet, that is then supposed to be exported with bunch of merged cells.
There are multiple sections to the sheet but within each section there is a known amount of cells per row.
My only working solution without .Select is to use .Cells
Example:
For row=0 to 12
with rng.Offset(1,0)
.cells(row+1,1)=arrdata(1+(row*6))
.cells(row+1,3)=arrdata(2+(row*6))
.cells(row+1,7)=arrdata(3+(row*6))
.cells(row+1,9)=arrdata(4+(row*6))
.cells(row+1,14)=arrdata(1+(row*6))
.cells(row+1,16)=arrdata(1+(row*6))
End with
Next row
but this is pretty ardous.
EDIT: Here is a screenshot:
target area
The idea is that the amount of rows is completely flexible, depending on the transaction. So sometimes there is only one row, but can be anything really.
My code generates this section using relative references based on named ranges.
And then from the ugly sheet (where all information is stored in a single row) the values are fed into a one-dimensional array, then the array should be fed into the nice looking sheet.
If the sheet had no merged cells, the formula would look quite simple:
Dim i as integer, j as integer
Dim ws as worksheet: set ws = Worksheets("Printable")
'data array has already been filled with info in a linear order beforehand
k=1
For i=1 to item_qt 'number of cost items lines
For j=1 to item_col 'number of detail columns (in this section)
ws.Range("item_title").Offset(1,0).Cells(i,j).Value=data(k)
k=k+1
Next j
Next i
But because of the nature of this sheet - supposed to be printable and nicer on the eyes - I can't do that and have to find a way how to switch between the merged cells.
Hope this Edit cleared some things up.
I am also looking into the suggestions now to see if I can apply those somehow, but if anybody knows of something better, I am open for everything.
If you're stepping through merged columns, you could use something like
For i = startColumn To endColumn
If Cells(row,StartColumn).MergeArea.Columns.Count > 1 Then
'Do Stuff
i = i + Cells(row,StartColumn).MergeArea.Columns.Count - 1
End If
Debug.Print i
Next i
This will test for merged columns and then jump to the next column after the merge.
EDIT:
Seeing your data structure added in your edit, you could incorporate the MergeArea.Columns.Count method into your For j-Next j loop like
k=1
For i=1 to item_qt 'number of cost items lines
For j=1 to item_col 'number of detail columns (in this section) <-this will need to
'be the total number of columns, not just the number of
'detail fields
ws.Range("item_title").Offset(1,0).Cells(i,j).Value=data(k)
j = j + ws.Range("item_title").Offset(1,0).Cells(i,j).MergeArea.Columns.Count - 1
k=k+1
Next j
Next i
By searching for "excel find merged cells vba" Google comes up with:
How To Identify And Select All Merged Cells In Excel?
https://www.extendoffice.com/documents/excel/962-excel-select-merged-cells.html
Sub FindMergedcells()
'updateby Extendoffice 20160106
Dim x As Range
For Each x In ActiveSheet.UsedRange
If x.MergeCells Then
x.Interior.ColorIndex = 8
End If
Next
End Sub
and
2 Practical Methods to Find Merged Cells in Your Excel
https://www.datanumen.com/blogs/2-practical-methods-find-merged-cells-excel/
Sub FindMerge()
Dim cel As Range
For Each cel In ActiveSheet.Range(“A1:G13”)
If cel.MergeCells = True Then
‘change the color to make it different
cel.Interior.Color = vbYellow
End If
Next cel
End Sub
EDIT: If I instead wanted to autofill these cells, would the following code work?
Sub BC_Edit()
' Define width and height of table
Dim datasetWidth, datasetHeight As Integer
' Find values for width and height of table
datasetWidth = Range("A1").End(xlToRight).Column
datasetHeight = Range("A1").End(xlDown).Row
' Loop over each column
For x = 1 To datasetWidth
Set sourceRange = Cells(2,x)
Set fillRange = Range(Cells(3, x), Cells(datasetHeight, x))
sourceRange.AutoFill Destination:=fillRange
Next
End Sub
I'm working with a couple of extremely large datasets - each approximately 3000 rows by 4000 columns. While Excel may not be the best tool for the job, I have already built a significant amount of infrastructure around the data and cannot move to a different framework. I'm using Excel 2007.
In a particular worksheet, when I try to Autofill using a formula I have inputted for the entire second column B (3000 x 1) via copy and paste of this column into the remaining 3000 by 3998 selection, or some part of this selection, Excel gives me a memory/resources error. So I would like to instead loop through each row and Autofill across all the columns. (In other words, I'd like to use A2 to autofill A3:A4000, B2 to autofill B3:B4000, and so on.) Perhaps this would help with the memory issue. How would I go about writing a macro to accomplish this?
I'd appreciate any advice on this issue, and perhaps some help with the appropriate VBA code, if possible.
Here is a pretty basic example of a macro to set columns below 2 to the formula of column 2.
It would be best to have this attached to a button or something similar rather than running every time you open the sheet.
Sub Button_Click()
' Define width and height of table
Dim datasetWidth, datasetHeight As Integer
' Find values for width and height of table
datasetWidth = Range("A1").End(xlToRight).Column
datasetHeight = Range("A1").End(xlDown).Row
' Loop over each column
For x = 1 To datasetWidth
' From row 3 to the height of data, set the formula of the cells to
' the formula contained in row 2 of that column
Range(Cells(3, x), Cells(datasetHeight, x)).Formula = Cells(2, x).Formula
Next
End Sub
I have searched the web and tried all possible solutions, but in vain.
There are auditors looking at specific customers in specific areas.
I have three worksheets with data on it: Summary sheet, Raw Data sheet and an Area Listing sheet. The data gets transferred from the data sheet to the summary sheet, but contains areas that do not belong to the specific auditor. The area listings have an indicator Yes/No that must be used to clear the summary sheet of unwanted areas.
I therefore need to delete the unwanted areas from the Summary sheet by first matching the area names on both sheets and then delete those that are marked with a "No" on the area listing sheet.
The core coding I have tried:
If ActiveCell.Formula = "=VLookup(B2,Areas!C2:D,1,False)"=True _
And Sheets("Areas").Range("D2").Value = "No" Then
Sheets("Summary").EntireRow.Delete
Where B2 is the column in Summary containing the Areas and C2 is the corresponding column in Areas with D2 the column in Areas listing the selections of Yes / No.
How do I then write the code to delete the Rows in Summary where the areas are matching in the Summary and the Areas sheet and the indicator in the Areas sheet is "No"?
I have also tried:
For I = LastRowCheck To 1 Step -1
If Sheets("Summary").Range("B" & LastRowCheck).Value = _
Sheets("Areas").Range("C" & sdRow).Value _
And Sheets("Areas").Range("D" & NoRow).Value = "No" Then
If DelRange is Nothing Then
Set DelRange = Sheets("Summary").Rows(i)
End If
If not DelRange Is Nothing Then DelRange.EntireRow.Delete
End If
Next i
Can somebody please tell me where I am missing the boat?
it seems to me, that the areas sheet is going to have.. lets say 50 different areas, and the summary sheet is going to have however many rows, each with an area from the area sheet. so multiple rows would have the same area. so, you want to loop through all the rows on the summary sheet, find the corresponding area from the area sheet, and see if that area has a "no" value in column D.
given the above understanding, the following 2 options should both work:
A)
loop through all rows on areas sheet and load all area names with D
column value of "No" into an array.
loop through all rows on summary sheet
use inner loop to check and see if current row in summary sheet is
found in array of "bad areas"
delete entire row
B)
use a loop to find all rows in the area sheet with a D column value of "No" and load the names from each of these areas into an array.
use said array as the criteria for a data filter, filtering the area name column in the summary sheet
delete all visible rows (ones with areas found on areas sheet with D column value of "No"
A Code:
Dim strArray() as variant
ReDim strArray(1 to 1)
dim deleted as boolean 'keeps track of whether row was delete or not
Sheets("Area Sheet").Activate
Range ("A1").Activate 'where assuming column a has area name
for i = 1 to lastrow
if ActiveCell.offset(0, 3).formulaR1C1 = "No" then 'column D, I have had bad experience with .value so i always use formulaR1C1
strArray(i) = ActiveCell.formulaR1C1
end if
ActiveCell.offset(1,0).activate
next
Sheets("Summary Sheet").activate
Range("A1") ' again, assuing a has area name
for i = 1 to endrow
delete = false 'reset delete before inner loop
for j = 1 to ubound(strArray)
if ActiveCell.formulaR1C1 = strArray(i) then
ActiveCell.entireRow.delete xlShiftUp
deleted = true
exit for 'exits inner loop
else
deleted = false
end if
next
if not deleted then ActiveCell.offset(1,0).offset ' move down to next row if curent row was not deleted
next
B Code:
'use same as A code to get all areas with D Column "No" into array
Dim rng as Range
Range("A1").activate ' after activating summary sheet, again, assuming a has area name
ActiveCell.entireColumn.select
selection.AutoFilter Field:=1, Criteria1:=strArray, Operator:=xlFilterValues ' this will filter so only rows with area and column D of "No" will be visible.
set rng = Range("A1", Cells(lastrow, lastcolumn)).SpecialCells(xlCellTypeVisible) ' this will get all visible cells (ones that are visible with current filter condition)
rng.entirerow.delete xlshiftup 'will delete all rows in rng
depending on the amount of data, A) with application.Screenupdating =false may be faster than filter (use doesnt see whats happening behind the scenes.) do make sure to do Application.screenupdating = true again after to turn that back on.
code may need tweaking for spelling mistakes etc.. but basis should be there
I did not set endrow ever as everyone has their own way of getting the last row.
HTH
good luck!
I have a pivot table in an Excel worksheet that contains the result of a query made to my database. I would like to format the information automatically based on every other data set.
The information contains 4 weeks' (1 month) worth of records for each employee sorted by an employee ID number. I would like to write a module so that it will highlight every other record (employee data set) with a different color. Is this even possible to do? Thanks for the help!
If you insist with solving your problem utilizing VBA here is an example. You'll need to specify start ranges. Please not that marking whole row will use more memory (increasing file size) so I would rather use example: range("A2:E2).select ....
Sub FormatEverySecondRow()
range("A2").EntireRow.Select
Do While ActiveCell.value <> ""
Selection.Interior.ColorIndex = 15
ActiveCell.offset(2, 0).EntireRow.Select
Loop
End Sub
use a helper column (K if I count the columns in your example)
insert into K2:
=IF(ISBlank(C2),K1,MOD(K1+1,2))
then use conditional formatting to highlight the row:
Note the formula does not have a $ sign before the 2 (i.e. $K2, not $K$2)
This might be useful to you:
Sub HighlightDifferentRows()
Dim wksht As Worksheet
Dim wkb As Workbook
Dim row As Range
Dim FloatColor As Long
FloatColor = RGB(100, 100, 100)
Set wbk = ThisWorkbook
Application.ScreenUpdating = False
For Each row In Sheets(1).UsedRange.Rows
row.Interior.Color = FloatColor
If row.Cells(1, 4).Value <> row.Cells(2, 4).Value Then
FloatColor = -FloatColor
End If
Next row
Application.ScreenUpdating = True
End Sub
It alternates row colors whenever a cell value is not the same as the one below it. Right now it is set to grayish colors but you could change it to something brighter if you wanted. You could put in your own logic to get whatever colors you wanted. Good Luck.