I recorded this then added the LR = LastRow to make it dynamic but I can not figure out how to remove all the selections that go on
Also these both do the samething but is one way of writting the array better then the other i.e faster, more stable...
Thanks
Selection.FormulaArray = "=ISNUMBER(MATCH(RC[-5]&RC[-6],R1C1:R" & LR & "C1 & R1C2:R" & LR & "C2,0))"
Selection.FormulaArray = "=ISNUMBER(MATCH(B1&A1,$A$1:$A$" & LR & " & $B$1:$B$" & LR & ",0))"
Recorded Macro
Sub Winding()
Dim ws As Worksheet
Dim Rng As Range
Dim LR As Long
Set ws = Sheets("Unpivot_RegistrationData")
LR = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
Set Rng = ws.Range("G1").Resize(LR, 1)
Range("G1").Select
Selection.FormulaArray = "=ISNUMBER(MATCH(B1&A1,$A$1:$A$" & LR & " & $B$1:$B$" & LR & ",0))"
Selection.AutoFill Destination:=Rng, Type:=xlFillDefault
End Sub
Firstly, preference for A1 or R1C1 style should be driven by ease of constructing the formula string. There is no diffrence in performance or stability
To remove the Selection try this
Note that I have removed the AutoFill, and applied to formula to the whole range in one step.
Sub Winding()
Dim Rng As Range
Dim LR As Long
With Worksheets("Unpivot_RegistrationData")
LR = .Cells(.Rows.Count, 1).End(xlUp).Row
Set Rng = .Range("G1:G" & LR)
End With
Rng.Cells(1, 1).FormulaArray = _
"=ISNUMBER(MATCH(B1&A1,$A$1:$A$" & LR & " & $B$1:$B$" & LR & ",0))"
Rng.Cells(1, 1).AutoFill Destination:=Rng, Type:=xlFillDefault
End Sub
Related
I'd like to use a loop to go through each of the criteria in a filter, then calculate and output averages. My code below calculates the averages and outputs them on the next empty line of the second sheet, but unfortunately, this only works for the first filter selection. After each new iteration of the loop, nothing happens. Can anyone help?
source data
output
Option Explicit
Sub avg()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim cell As Range
Dim lastrow As Long
Dim RowCount As Long
Dim rng1 As Range
Dim nextrow As Long
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
lastrow = ws1.Cells(Rows.Count, 1).End(xlUp).Row
RowCount = ws2.Cells(Rows.Count, 1).End(xlUp).Row
Set rng1 = ws1.Range("G2:G" & lastrow)
For Each cell In rng1.SpecialCells(xlCellTypeVisible)
With ws1.AutoFilter.Range
ws2.Range("A" & RowCount + 1) = ws1.Range("B" & .Offset(1, 0).SpecialCells(xlCellTypeVisible)(1).Row).Value2
ws2.Range("B" & RowCount + 1) = ws1.Range("F" & .Offset(1, 0).SpecialCells(xlCellTypeVisible)(1).Row).Value2
End With
ws2.Range("C" & RowCount + 1) = Application.WorksheetFunction.Average(ws1.Range("Y2:Y" & lastrow & ",Z2:Z" & lastrow & ",AA2:AA" & lastrow _
& ",AD2:AD" & lastrow & ",AE2:AE" & lastrow & ",AI2:AI" & lastrow & ",AK2:AK" & lastrow & ",AL2:AL" & lastrow).SpecialCells(xlCellTypeVisible))
ws2.Range("D" & RowCount + 1) = Application.WorksheetFunction.Average(ws1.Range("AF2:AF" & lastrow & ",AM2:AM" & lastrow & ",AP2:AP" & lastrow _
& ",AQ2:AQ" & lastrow & ",AR2:AR" & lastrow & ",AS2:AS" & lastrow & ",AT2:AT" & lastrow & ",AU2:AU" & lastrow).SpecialCells(xlCellTypeVisible))
ws2.Range("E" & RowCount + 1) = Application.WorksheetFunction.Average(ws1.Range("AW2:AW" & lastrow & ",AX2:AX" & lastrow & ",AY2:AY" & lastrow).SpecialCells(xlCellTypeVisible))
Next cell
End Sub
Few changes made in your macro. Note the newly added array for unique values of filter criteria and loop changed from each cells to array. lastrow and RowCount variables replaced by lastrow1 and lastrow2.
Sub avg()
Dim wb As Workbook
Set wb = ThisWorkbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim cell As Range, rng1 As Range, rng1Crt As Range
Dim lastrow1 As Long, lastrow2 As Long, arr As Variant
Set ws1 = wb.Worksheets("Sheet1")
Set ws2 = wb.Worksheets("Sheet2")
lastrow1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
Set rng1 = ws1.Range("G1:G" & lastrow1)
rng1.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Set rng1Crt = rng1.Cells.SpecialCells(xlCellTypeVisible)
'Populating array with filter criteria values
ReDim arr(0 To rng1Crt.Cells.Count - 1)
i = 0
For Each cell In rng1Crt.Cells
arr(i) = cell.Value
i = i + 1
Next
ws1.ShowAllData
rng1.AutoFilter
For i = 1 To UBound(arr)
lastrow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row
rng1.AutoFilter Field:=1, Criteria1:=arr(i)
With ws1.AutoFilter.Range
ws2.Range("A" & lastrow2 + 1) = ws1.Range("B" & .Offset(1, 0).SpecialCells(xlCellTypeVisible)(1).Row).Value2
ws2.Range("B" & lastrow2 + 1) = ws1.Range("F" & .Offset(1, 0).SpecialCells(xlCellTypeVisible)(1).Row).Value2
End With
ws2.Range("C" & lastrow2 + 1) = Application.WorksheetFunction.Average(ws1.Range("Y2:Y" & lastrow1 & ",Z2:Z" & lastrow1 & ",AA2:AA" & lastrow1 _
& ",AD2:AD" & lastrow1 & ",AE2:AE" & lastrow1 & ",AI2:AI" & lastrow1 & ",AK2:AK" & lastrow1 & ",AL2:AL" & lastrow1).SpecialCells(xlCellTypeVisible))
ws2.Range("D" & lastrow2 + 1) = Application.WorksheetFunction.Average(ws1.Range("AF2:AF" & lastrow1 & ",AM2:AM" & lastrow1 & ",AP2:AP" & lastrow1 _
& ",AQ2:AQ" & lastrow1 & ",AR2:AR" & lastrow1 & ",AS2:AS" & lastrow1 & ",AT2:AT" & lastrow1 & ",AU2:AU" & lastrow1).SpecialCells(xlCellTypeVisible))
ws2.Range("E" & lastrow2 + 1) = Application.WorksheetFunction.Average(ws1.Range("AW2:AW" & lastrow1 & ",AX2:AX" & lastrow1 & ",AY2:AY" & lastrow1).SpecialCells(xlCellTypeVisible))
Next
End Sub
I copied a range from one worksheet into the next empty row in another worksheet through below code. But this raise an exception
run-time error 424; 'Object Required'.
Sub copy()
Dim lr1 As Long
lr1 = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
Worksheets("Sheet1").Range("A1:A" & lr1).copy
End Sub
Sub paste()
Dim lr2 As Long
lr2 = Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
Worksheets("Sheet2").Range("A" & lr2).Offset(1, 0).PasteSpecial.xlValues
End Sub
The error occurs when I run the "Paste" macro. I want to reiterate that the copied range does get pasted in the next empty cell, however this error message get displayed.
Which part of the "Paste" macro triggers this message?
When pasting just values, skip the clipboard:
Sub copy()
Dim lr1 As Long
lr1 = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
Dim rng As Range
Set rng = Worksheets("Sheet1").Range("A1:A" & lr1)
Dim lr2 As Long
lr2 = Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
Worksheets("Sheet2").Range("A" & lr2).Offset(1, 0).Resize(rng.Rows.Count).Value = rng.Value
End Sub
A single sub and modification:
Sub copypaste()
Dim lr1 As Long, lr2 As Long
lr1 = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
Worksheets("Sheet1").Range("A1:A" & lr1).copy
lr2 = Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
Worksheets("Sheet2").Range("A" & lr2).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End Sub
I've changed my code as per BigBen's correction to the following;
Sub copy()
Dim lr1 As Long
Dim lr2 As Long
lr1 = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
lr2 = Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
Worksheets("Sheet1").Range("A1:A" & lr1).copy
Worksheets("Sheet2").Range("A" & lr2).Offset(1, 0).PasteSpecial paste:=xlPasteValues
End Sub
#Scott Craner: I had two subs as I'm new to vba and it's a way to break down the code so that I can understand what the code is supposed to do, but I guess that can be done with comments.
My error comes at the definition of LR. It is error object required 424. Anyone knows the problem?
Sub
Dim LR As Long
Dim FLR As Long
LR = wb.Sheets("DTH&TPD Claims List").Cells(Row.Count, 2).End(xlUp).Row
FLR = wb.Sheets("DTH&TPD Claims List").Cells(Row.Count, 1).End(xlUp).Row + 1
wb.Sheets("DTH&TPD Claims List").Cells(FLR, 1).Value = "19"
wb.Sheets("DTH&TPD Claims List").Cells(FLR, 1).Select
Selection.AutoFill Destination:=Range("A" & FLR & ":" & "A" & LR)
End Sub
After Rectification:
There is Error in Selection.Autofill in the Below code now.
Sub tst()
Dim LR As Long
Dim FLR As Long
Dim wb As Workbook
Set wb = ActiveWorkbook 'assuming you want your code to run in
With wb.Sheets("DTH&TPD Claims List")
LR = .Cells(.Rows.Count, 2).End(xlUp).row
FLR = .Cells(.Rows.Count, 1).End(xlUp).row + 1
.Cells(FLR, 1).Value = "19"
.Cells(FLR, 1).Select
Msgbox LR & " " & FLR
Selection.AutoFill Destination:=.Range("A" & FLR & ":A" & LR)
End With
End Sub
Problems:
No declaration of wb
Wrong formula row.count
Try this:
Sub tst()
Dim LR As Long
Dim FLR As Long
Dim wb As Workbook
Set wb = ActiveWorkbook 'assuming you want your code to run in
With wb.Sheets("DTH&TPD Claims List")
LR = .Cells(.Rows.Count, 2).End(xlUp).row
FLR = .Cells(.Rows.Count, 1).End(xlUp).row + 1
.Cells(FLR, 1).Value = "19"
.Cells(FLR, 1).Select
Msgbox LR & " " & FLR
Selection.AutoFill Destination:=.Range("A" & FLR & ":A" & LR)
End With
End Sub
I have cleaned up your code as well.
I am having trouble with the below code. "Backend" is the Source Sheet and "Availability" is the Target sheet. Any help is appreciated.
Sub CopyA()
Dim lr As Long, lr2 As Long, r As Long
lr = Sheets("Backend").Cells(Rows.Count, "AB").End(xlUp).Row
lr2 = Sheets("Availability").Cells(Rows.Count, "A").End(xlUp).Row
For r = lr To 2 Step -1
If Range("Backend!AB" & r).Value = "A" Then
Range("Availability!A" & lr2 + 1 & ":C" & lr2 + 1) =
Range("Backend!V" & r & ":X" & r).Value2
lr2 = Sheets("Availability").Cells(Rows.Count, "A").End(xlUp).Row
End If
Next r
End Sub
Based on your code I think you are trying to copy columns V:X from sheet Backend if column AB = A and paste the data into column A of sheet Availability.
This code achieves that:
Sub CopyData()
Dim lastRow As Long, rw As Long
lastRow = Sheets("Backend").Cells(Rows.Count, "AB").End(xlUp).Row
With Worksheets("Backend")
For rw = lastRow To 2 Step -1
If .Range("AB" & rw) = "A" Then
pasteRow = Worksheets("Availability").Cells(Rows.Count, "A").End(xlUp).Row + 1
Range("V" & rw & ":X" & rw).Copy Destination:=Worksheets("Availability").Range("A" & pasteRow & ":C" & pasteRow)
End If
Next rw
End With
End Sub
In your original code you are looping backwards with Step -1. A consequence of this is that the data pasted into Availability will be in reverse order. If you want the pasted data to appear in the order it is found on backend then use this code instead:
Sub CopyData2()
Dim copyRng As Range, cl As Range
Set copyRng = Worksheets("Backend").Range("AB2:AB" & Worksheets("Backend").Cells(Rows.Count, "AB").End(xlUp).Row)
With Worksheets("Availability")
For Each cl In copyRng
If cl = "A" Then
pasteRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
Worksheets("Backend").Range("V" & cl.Row & ":X" & cl.Row).Copy Destination:=.Range("A" & pasteRow & ":C" & pasteRow)
End If
Next cl
End With
End Sub
I'm trying to write a short macro that includes a line that averages a range of cells. In each worksheet that I want to run the macro in the range of cells is a different length.
After running the macro the cell E1 contains "=AVERAGE(Rng)"
Dim homeSheet As Worksheet
Set homeSheet = ActiveSheet
Dim lastRow As Long
Dim Rng As Range
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Set Rng = Range("B2:B" & lastRow)
Range("E1").Formula = "=Average(Rng)"
Range("E2").Formula = "=STDEV(Rng)"
Range("E3").Select
ActiveWindow.SmallScroll Down:=-2
End Sub
I've also tried
Range("E1").Formula = "=Average(Range("B2:B" & lastRow))"
without trying to use Set Rng = Range("B2:B" & lastRow)
You need to use Rng.Address in your formulas. Try to change your code into this:
Sub Avg()
Dim homeSheet As Worksheet
Set homeSheet = ActiveSheet
Dim lastRow As Long
Dim Rng As Range
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Set Rng = Range("B2:B" & lastRow)
Range("E1").Formula = "=Average(" & Rng.Address & ")"
Range("E2").Formula = "=STDEV(" & Rng.Address & ")"
Range("E3").Select
End Sub
If you were to use the second method you have tried, you would need to change that line of code to:
Range("E1").Formula = "=Average(" & Range("B2:B" & lastRow).Address & ")"