I am trying to print a report from a sheet called Patrol based on the date of the data.
Range A1 contains different dates but I only want to print the data in rows with first row = to (date + 1) ie tomorrows date.(To print delivery details for the next day)
For each row there is date and 16 other cells. The code below is only printing the table headers
Private Sub Comprintpatrol_Click()
Range("A1").AutoFilter Field:=1, Criteria1:=Format(Date + 1, Range("A2").NumberFormatLocal)
ActiveSheet.PrintOut
' or
Range("A1").CurrentRegion.PrintOut
Range("A1").AutoFilter
End Sub
Any Ideas?
I think you're off in saying "Range A1 contains different dates". I think you mean "Column A contains different dates". (Range A1 is a single cell, the upper-left cell on the sheet)
You can get column a from the Range function by passing the string "A:A": Range("A:A")
You could also try the UsedRange instead of CurrentRegion. The latter can be tricky because it depends a lot on how your data are set (especially if you have empty cells).
Something like:
Private Sub Comprintpatrol_Click()
Range("A1").AutoFilter Field:=1, Criteria1:=Format(Date + 1, Range("A2").NumberFormatLocal)
ActiveSheet.PrintOut
' or
ActiveSheet.UsedRange.PrintOut
Range("A1").AutoFilter
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 need some help with an excel problem.
It is a combination of the two problems below:
1) Excel - Popup message with sound alert when cell value meets certain criteria
2) VBA code to show Message Box popup if the formula in the target cell exceeds a certain value
In Sheet1, I have a range of products and sales figure.
Example: Sheet1
In Sheet2, I have multiple columns of sumif() functions. Example: Sheet2.
It contains a column of names in (A:A) and data in (B:B) & (C:C) which are linked to cells in other sheets. I would like a pop up notification saying ("Text in column A" sold is > 20) when the value of any cell in column B exceeds 20 or column C exceeds 40.
For example: If one of the cell value in column "B" gets updated to 33 (which is >20) and the corresponding cell value in column "A" contains text as "Charlie", excel sheet should popup message saying "Charlie sold is > 20".
The below VBA code accomplishes this IF it was raw data. However, it does not work when the cells are linked to data from other sheets, as in the case of this workbook.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.column = 2 and target.value > 1 Then
MsgBox target.offset(0,-1).text & " sold is > 20"
End If
End Sub
This alternative code works with data linked from other sheets, however it only applies to a specific cell, not an entire column.
Private Sub Worksheet_Calculate()
If Sheets("Sheet2").Range("B2").Value > 20 Then
MsgBox "B2 is >20", vbOKOnly
End If
End Sub
What I'm trying to achieve is this: As I input my raw data in Sheet1, the figures in Sheet2 column(B:B) and column(C:C) get updated. Once any of the cells in Sheet2 column(B:B) exceed 20 or column(C:C) exceed 40, there will be a popup notification that links back to column A text such as MsgBox target.offset(0,-1).text & " sold is > 20". Is there a way to combine the above two codes to achieve this?
Any alternative solutions are welcome too, thank you!
Compare all the Sums in Summary table
Private Sub Worksheet_Calculate()
Dim RangeToCheck As Range
Dim Cell As Range
Set RangeToCheck = Sheets("Sheet2").Range("B2:B5") 'See comment #1
For Each Cell In RangeToCheck.Cells
With Cell
If .Value2 > 20 Then
MsgBox "Product: " & .Offset(columnoffset:=-1).Value2 & _
" in cell: " & .Address & " is " & .Value2 & ">20", vbOKOnly
End If
End With
Next
End Sub
Comments
I recommend turning the range on Sheet2 to Excel table and using ListObject and Listcolumns instead.
Off topic hint: You can also use some counter, put the range into an VBA array and loop through array, it will be faster, than refering to sheet cell one after another. See Writing efficient VBA UDFs (Part 1).
I implemented a button that ask the user where to add a column, and the button takes the user input(A-Z) and generates the column until the end of the table NOT SPREADSHEET. The column ends based on how many rows there are in my table, meaning if there are 10 rows, after the user clicks the button an inputs where they want the column to be(They input a letter of the column A-Z), I should not see a column box on line 11 of the spreadsheet.
Now I've managed to do this my issue is below:
My issue is the cells the button generate does not include the lines or boxes around the cells so that you are aware that its an extension of the table?
here is what I mean: Picture of spreadsheet
notice the i column there are no lines around the cells?
Here is code, I think I am missing a copy function after the line
shift:=xlRight, but I don't know how to implement it?
I don't want to use macros because since the tables rows and column change due to the user's input I will have to constantly hard-code the range into the macro which i dont want.
Trust me I tried it an its annoying.
Private Sub CommandButton2_Click()
Dim x As Variant
Dim ColumnNum
x = InputBox("Enter a column that you want to add: ", "What column?")
If x = "" Then Exit Sub
ColumnNum = x
ThisWorkbook.Sheets("Sheet1").Columns(ColumnNum).Insert shift:=xlRight
ThisWorkbook.Sheets("Sheet1").Columns(ColumnNum).ClearContents
End Sub
you could try this:
Private Sub CommandButton2_Click()
Dim colIndex As Variant
colIndex = Application.InputBox("Enter a column that you want to add: ", "What column?", , , , , , 2) '<--| force a text
If colIndex = "" Then Exit Sub
With ThisWorkbook.Sheets("Sheet1").Columns(colIndex) '<--| reference column you want to insert
.Insert shift:=xlRight '<--| insert a new column , then the referenced one shifts one column to the right of the inserted one
.Offset(, -2).Copy '<--| copy the column two columns to the left of the referenced one (i.e. one column left of the new one)
.Offset(, -1).PasteSpecial xlPasteFormats '<--| paste formats to the new column
Application.CutCopyMode = False
End With
End Sub
I'm currently transposing data from column to a row in a different spreadsheet one at a time. I began using the "record macro" function but I'm having trouble. I need the macro to copy data column by column and transpose it into a corresponding row, 15 rows apart. There are 100 entries per document. For example; P4 - P23 in document 1 needs to be transposed to M217 - AF217 in document 2. Q4 - Q23 needs to be transposed to M232 - AF 232, up to row 1501.
You can use this simple sub to transpose ranges.
Just give it the source and destination as a range:
Sub TransposeRange(SourceRange As Range, DestinationRange As Range)
SourceRange.Copy
DestinationRange.PasteSpecial Transpose:=True
End Sub
'Example:
Sub MoveRange()
Call TransposeRange(Range("P4:P24"), Range("M232"))
End Sub
'Transpose columns 1-10 and put them row by row at column O
Sub MoveColumns()
For x = 1 To 10
Call TransposeRange(Intersect(UsedRange, Cells(1, x).EntireColumn), Cells(x, 15))
Next x
End Sub
Result:
Trying to run a macro in Excel to remove non dupes so dupes can be examined easily.
Step through each cell in column "B", starting at B2 (B1 is header)
During run, if current cell B has a match anywhere in column B - leave it, if it' unique - remove entire row
The code below is executing with inconsistent results.
Looking for some insight
Sub RemoveNonDupes()
Selection.Copy
Range("B2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("B2:B5000").AdvancedFilter Action:= xlFilterInPlace, CriteriaRange:= Range("B2"), Unique := True
Range("B2:B5000").SpecialCells(xlCellTypeVisible).EntireRow.Delete
ActiveSheet.showalldata
End Sub
Not the most direct route, but you could have the macro insert between B and C. Then dump a formula in that column that counts.
Something like =countifs(B:B,B:B) That will give you a count of how many times a record shows, then you can set the script to Loop deleting any row where that value is 1.
Something like
Sub Duplicates()
Columns("B:B").Insert Shift:=xlToRight ' inserts a column after b
count = Sheet1.Range("B:B").Cells.SpecialCells(xlCellTypeConstants).count ' counts how many records you have
crange = "C1:C" & count ' this defines the range your formula's go in if your data doesn't start in b1, change the c1 above to match the row your data starts
Sheet1.Range(crange).Formula = "=countifs(B:B,B:B)" ' This applies the same forumla to the range
ct=0
ct2=0 'This section will go cell by cell and delete the entire row if the count value is 1
Do While ct2 < Sheet1.Range("C:C").Cells.SpecialCells(xlCellTypeConstants).count
For ct = 0 To Sheet1.Range("C:C").Cells.SpecialCells(xlCellTypeConstants).count
If Sheet1.Range("C1").Offset(ct, 0).Value > 1 Then
Sheet1.Range("C1").Offset(ct, 0).EntireRow.Delete
End If
Next
ct2 = ct2 + 1
Loop
Sheet1.Columns("B:B").EntireColumn.delete
end sub
Code isn't pretty, but it should do the job.
**Updated code per comments
Sub Duplicates()
Columns("C:C").Insert Shift:=xlToRight ' inserts a column after b
count = Activesheet.Range("C:C").Cells.SpecialCells(xlCellTypeConstants).count ' counts how many records you have
crange = "C1:C" & count ' this defines the range your formula's go in if your data doesn't start in b1, change the c1 above to match the row your data starts
Activesheet.Range(crange).Formula = "=countifs(B:B,B:B)" ' This applies the same forumla to the range
ct=0
ct2=0 'This section will go cell by cell and delete the entire row if the count value is 1
'''''
Do While ct2 < Activesheet.Range("C:C").Cells.SpecialCells(xlCellTypeConstants).count
For ct = 0 To Activesheet.Range("C:C").Cells.SpecialCells(xlCellTypeConstants).count
If Activesheet.Range("C1").Offset(ct, 0).Value = 1 Then
Activesheet.Range("C1").Offset(ct, 0).EntireRow.Delete
End If
Next
ct2 = ct2 + 1
Loop
ActiveSheet.Columns("C:C").EntireColumn.delete
end sub
You can try that updated code, the part with the Do Loop is what will delete each column, I fixed it to delete any row where the count is 1.
Based on what I understand, your data should be in column B and the counts should be in column C. If that isn't correct, update the formula's to match
Chris, to examine the unique values in a given range of data, I suggest utilizing Excel's Advanced Copy function in a slightly different way:
Range("RangeWithDupes").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("TargetRange"), unique:=True
The operation will provide you a list of unique values from 'RangeWithDupes' located at 'TargetRange'. You can then use the resultant range to manipulate the source data in many ways. Hope this helps.