I have written some code that, when there is a Duplicate value in Column A, then True = False would be there, same as we do in Excel, A1=A2, until the last row where we have data in A.
I am unsure how to find the last row , so i have coded the range up to T9000, but there could be data up to T3500, or sometimes T15000.
Range("A1:A5000").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes
ActiveCell.FormulaR1C1 = "Dup"
Range("T2").Select
ActiveCell.FormulaR1C1 = "=R[-1]C[-19]=RC[-19]"
Range("T3").Select
Selection.End(xlDown).Select
Range("S1048576").Select
Selection.End(xlUp).Select
Range("T9000").Select
Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown
I am unsure about the placement of your Dup should it be cell A1? The rest of your code can be contracted by using your last row variable.
lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
Contracted code:
Option Explicit
Sub FindDups()
Dim wb As Workbook
Dim wsSource As Worksheet
Dim lastRow As Long
Set wb = ThisWorkbook 'Variable assignments
Set wsSource = wb.Worksheets("Sheet2")
lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row 'find last row by coming from the bottom of the sheet and finding last used cell in column
With wsSource
.Range("A1").FormulaR1C1 = "Dup"
.Range("A1:A" & lastRow).Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes
.Range("T2:T" & lastRow).FormulaR1C1 = "=IF(RC[-19]=R[-1]C[-19],""Duplicate"", RC[-19])"
End With
End Sub
Related
I want to copy all rows below Row 3 in sheet2 and paste them below the last row in sheet 1. I don't want to use 'Activesheet" like I have below. Is there another way to accomplish this?
(This doesn't work):
Rows("3:3").Select
Range(Selection, Selection.End(x1Down)).Select
Selection.Copy
Sheets("sheet1").Select
Range(Selection, Selection.End(x1Down)).Select
ActiveSheet.Paste
Dim ws as Worksheet
Set ws = Worksheets("mySheet") 'change name as needed
With ws
'assumes data is in a "table" format with all data rows in column A and data columns in row 1
Dim lRow as Long, lCol as Long
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
lCol = .Cells(1,.Columns.Count).End(xlToLeft).Column
.Range(.Range("A4"),.Cells(lRow,lCol)).Copy _
Worksheets("Sheet1").Range("A" & .Rows.Count).End(xlUp).Offset(1)
End With
I'm trying to copy data from columns AJ through AQ from one workbook and paste the values in a new workbook. The number of rows is variable (dependent on the user). I've tried implementing the following code, but it only pastes the first row into the new workbook:
Dim i, j, LastRow, LastRow2
Set OldBook = ActiveWorkbook
Set NewBook = Workbooks.Add(xlWBATWorksheet)
With NewBook
.ActiveSheet.Name = "GMD"
End With
OldBook.Activate
Sheets("Entry Sheet").Select
LastRow = ActiveSheet.Range("AJ" & Rows.Count).End(xlUp).Row ''Finds the last row of the column with text
LastRow2 = ActiveSheet.Range("AQ" & Rows.Count).End(xlUp).Row ''Finds the last row of the column with text
For i = 1 To LastRow ''Sets the range of rows to be copied including header
Range(Cells(i, 36), Cells(i, 43)).Select ''Selects relevant columns
Selection.Copy
NewBook.Activate
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues
OldBook.Activate
Sheets("Entry Sheet").Select
Next i
For j = 1 To LastRow ''Sets the range of Rows to be copied including header
Range(Cells(j, 43), Cells(j, 44)).Select ''Selects relevant columns
Selection.Copy
NewBook.Activate
Range("H1").Select
ActiveSheet.Paste
OldBook.Activate
Sheets("Entry Sheet").Select
Next j
Any observations on what I'm doing wrong?
The problem is that in you paste section you are only calling the first cell and it is in the loop so each time the loop will paste in cell A1.
Also if all you want is values, it is best to skip the clipboard and assign the values directly. With this you can avoid the loop all together.
Thirdly avoid using the select.
Edit: Removed loop and added the wrap text for the line breaks.
Dim i, LastRow
Dim ws As Worksheet
Set oldbook = ActiveWorkbook
Set ws = oldbook.Sheets("Entry Sheet")
Set newbook = Workbooks.Add(xlWBATWorksheet)
With newbook
.ActiveSheet.Name = "GMD"
End With
With ws
LastRow = .Range("AJ" & .Rows.Count).End(xlUp).Row ''Finds the last row of the column with text
newbook.Sheets("GMD").Range(newbook.Sheets("GMD").Cells(1, 1), newbook.Sheets("GMD").Cells(LastRow, 7)).Value = .Range(.Cells(1, 36), .Cells(LastRow, 43)).Value
End With
newbook.Sheets("GMD").Range("H:I").WrapText = True
Good day SO! :)
I'm using the following VBA to copy cells from column A (starting with row 2) with values less than the max data set value from column A, and paste them into column C (same rows), and for those column A cells that are the same value as the max data set value in column A, they are pasted into column C as zero (same rows) using an empty column B.
Cell D2 is the max value of the cell range in column A, as =MAX(A2:A100)
When running this macro (I found online) from a form button on the same sheet as the data it works like a charm:
Sub CopyOrReplaceWithZero ()
Dim LastRow As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("C2:C" & LastRow) = Evaluate("IF(A2:A" & LastRow & "=D2,B2:B" & LastRow & ",IF(A2:A" & _
LastRow & "<D2,A2:A" & LastRow & ",C2:C" & LastRow & "))")
End Sub
However, I need to specify the worksheet to run that macro on because I want to assign it to a form button on a different sheet. So when that button is clicked data is copied from that sheet (copySheet) to the target sheet (pasteSheet), where the above VBA then runs (on pasteSheet).
Here's what I have so far, and this may be a wrong-headed approach.
The first part for the copySheet and pasting into pasteSheet works fine. But the VBA above copies from copySheet and pastes into pasteSheet, while it should be copying and pasting from/to pasteSheet.
I know I'm doing something wrong but I can't figure out thus far:
Sub copyConvert()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Dim LastRow As Long
Set copySheet = Worksheets("sheet1")
Set pasteSheet = Worksheets("sheet2")
copySheet.Range("P1:P115").Copy
pasteSheet.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Application.DisplayAlerts = True
LastRow = Sheets("sheet2").Cells(Rows.Count, "A").End(xlUp).Row
pasteSheet.Range("C2:C" & LastRow) = Evaluate("IF(A2:A" & LastRow & "=D2,B2:B" & LastRow & ",IF(A2:A" & _
LastRow & "<D2,A2:A" & LastRow & ",C2:C" & LastRow & "))")
Application.ScreenUpdating = True
End Sub
So I guess I was overthinking the issue. I found an easier solution just using IF function, as so. I hope others may mind this useful:
This function simply puts a zero into column B (in the same row) if that row in column A is the max value for the data set in column A, otherwise, if the value in each row of column A is less than the max data set value in column A its pasted into column B (same row) without modification.
=IF(A2=$C$2, A2*0, IF(A2<$C$2, A2))
Cell C2 is =MAX(A2:A100)
And I'm still using the same copy/paste command:
Sub CopyPaste
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Set copySheet = Worksheets("sheet1")
Set pasteSheet = Worksheets("sheet2")
copySheet.Range("P1:P115").Copy
pasteSheet.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
I am trying to get a simple VBA code as part of a Macro that will put in column B the average of the values for each row.
I have code that generates a time series and fills a column per simulation such that each column is a time series starting at column C.
The number of simulations vary so I simply need something that averages the value for each point in time (ie for each row across all simulations) whilst adjusting for the number of simulations that are run (columns that are filled). I would then like it to generate a single graph of all the time series highlighting the average values that are calculated.
Many thanks if you can help!
Here, for example, is the code that takes the values for the time steps from sheet1 and places it in columnA sheet2. I would like the macro to now place the average in the appropriate row down Column B:
Sheets("Sheet1").Select
Range("E5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Sheet2").Select
Cells(1, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Try this
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long
Set ws = Sheets("Sheet1")
With ws
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("B2:B" & lRow).Formula = _
"=IF(ISERROR(AVERAGE(C2:E2)),"""",AVERAGE(C2:E2))"
End With
End Sub
FOLLOWUP
Try this
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long, lCol As Long
Dim ColNm As String
Set ws = Sheets("Sheet1")
With ws
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
lCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
ColNm = Split(.Cells(, lCol).Address, "$")(1)
.Range("B2:B" & lRow).Formula = "=IF(ISERROR(AVERAGE(C2:" _
& ColNm & _
"2)),"""",AVERAGE(C2:" & _
ColNm & "2))"
End With
End Sub
Try this although there will be lots of different variants on this code:
Sub AddAvgFormula()
With Sheets("Sheet2")
.Range("B2").FormulaR1C1 = "=AVERAGE(RC[1]:RC[3])"
.Range("B2").Copy
.Range("B2:B" & .Cells(Excel.Rows.Count, 1).End(Excel.xlUp).Row).PasteSpecial Excel.xlPasteFormulas
End With
End Sub
At the end of your current code before the End Sub add this:
Call AddAvgFormula
Here's a varient of the original code:
Sub AddAvgFormula()
With Sheets("Sheet2")
.Range("B2") = "=AVERAGE(C2:E2)"
.Range("B2").Copy
.Range("B2:B" & .Cells(Excel.Rows.Count, 1).End(Excel.xlUp).Row).PasteSpecial Excel.xlPasteFormulas
End With
End Sub
Another variant which is shorter but maybe not so intuitive:
Sub AddAvgFormula()
With Sheets("Sheet2")
.Range("B2:B" & .Cells(Excel.Rows.Count, 1).End(Excel.xlUp).Row) = "=AVERAGE(C2:E2)"
End With
End Sub
I have an ActiveSheet script, in where I take raw data move the data to rows Q:V. I have a VBA script that runs and shows where the last row is, in this case the last row is 77.
lastrow = .Cells(.Rows.Count, "Q").End(xlUp).Row
I want to have it where it takes from Q to V last row, copy, and paste it into sheet 1...
I am guessing it will look like this, but I want to verify here first... since my normal sites I go to are down for maintenance for some reason.
Sub test()
Dim wsPOD As Worksheet
Dim wsPOT As Worksheet
Dim wsPOA As Worksheet
Dim cel As Range
Dim lastrow As Long, i As Long, Er As Long
Set wsPOD = Sheets("PO Data")
Set wsPOT = Sheets("PO Tracking")
Set wsPOA = Sheets("PO Archive")
With ActiveSheet
.AutoFilterMode = False
Intersect(.UsedRange, .Columns("A")).Cut .Range("Q1")
Intersect(.UsedRange, .Columns("D")).Cut .Range("R1")
Intersect(.UsedRange, .Columns("C")).Cut .Range("S1")
Intersect(.UsedRange, .Columns("B")).Cut .Range("T1")
Intersect(.UsedRange, .Columns("G")).Cut .Range("U1")
Intersect(.UsedRange, .Columns("F")).Cut .Range("V1")
lastrow = .Cells(.Rows.Count, "N").End(xlUp).Row
Intersect (.UsedRange.Range("Q:V" & lastrow).Copy)
Intersect (wsPOT.Range("B3:H" & lastrow).PasteSpecialxlPasteFormats)
End With
End Sub
This obviously doesn't work, if someone can help me it be appreciated.
Is this what you are trying>
With ActiveSheet
.AutoFilterMode = False
'
'~~> Rest of the code
'
lastRow = .Range("N" & Rows.Count).End(xlUp).Row
.Range("Q1:V" & lastRow).Copy
wsPOT.Range("B3").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With
xlPasteFormats will only paste the formats and not the value. If you want to paste value then change xlPasteFormats to xlPasteValues
Option Explicit
Sub copylocation()
Dim EC As Long
Dim X As Long
Dim Y As Long
X = Range("B1").End(xlUp).Offset(1, 0).Row
EC = Range("b1").End(xlToLeft).Offset(0, X).Column
Windows("Book2").Activate
Range("b1:AB" & EC).Select
Selection.Copy
Windows("Book1").Activate
Range("b1").Select
ActiveSheet.Paste
End Sub