I'm trying to autofill down some formulas, but instead of updating the cell reference when copying down, it keeps the same reference. This is happening for copying down both the VLookup and If(and) statements. The relevant part of the code is below, the part in question below the comments 'Now let's get the 2014 Data and below.
Sub sidebyside()
'
' test Macro
'
'
Dim lastRow2014 As Long
ActiveSheet.Range("$A$10:$V$4388").AutoFilter Field:=11, Criteria1:="1"
lastRow2014 = Range("A" & Rows.Count).End(xlUp).Row
' Get side-by-side data for comparison
Range("E10").Value = "Full Name"
Range("Y10").Value = "Full name"
Range("Z10").Value = "2014 Data"
Range("AA10").Value = "2016 Data"
Range("Y11").Select
Range("Y11").Formula = "=E11"
'Copy this down to the lastrow of the lefthand side (lastRow2014)
Range("Y11").AutoFill Destination:=Range("Y11", "Y" & lastRow2014)
'Now let's get the 2014 data
'Range("I11: I" & lastRow2014).Copy Destination:=Range("Z11")
Range("Z11").FormulaR1C1 = "=VLOOKUP(Y11,E: I, 5, FALSE)"
Range("Z11").AutoFill Destination:=Range("Z11", "Z" & lastRow2014)
'Let's get the corresponding 2016 data.
'VLOOKUP!
Range("AA11").FormulaR1C1 = "=VLOOKUP(Y11,P:T,5,FALSE)"
Range("AA11").Select
'Selection.AutoFill Destination:=Range("AA3:AA" & Range(
Selection.AutoFill Destination:=Range("AA11:AA" & Range("T" & Rows.Count).End(xlUp).Row)
'Now, let's calculate the percentage. The trick will be the reference.
Range("AA4").FormulaR1C1 = "='Summary 2'!M3" 'This is the index from the summary tab
Range("AA10").Value = "Within?"
Range("AA11").Formula = "=IF(AND(Y11 <=(Z11 + ($AA$4 * Z11)), Y11 >= (Z11 - (Z11 * $AA$4))), ""WITHIN"", ""NOT"")"
Range("AA11").Select
Selection.FillDown
Instead of populating the first formula and filling it down, populate all formulas at once:
For example:
Range("Y11:Y" & lastRow2014).Formula = "=E11"
instead of:
Range("Y11").Select
Range("Y11").Formula = "=E11"
'Copy this down to the lastrow of the lefthand side (lastRow2014)
Range("Y11").AutoFill Destination:=Range("Y11", "Y" & lastRow2014)
Sticking to this, you can modify your Z equation with:
Range("Z11:Z" & lastRow2014).Formula = "=VLOOKUP(Y11,E:I, 5, FALSE)"
The issue you are running into is the extra space in your VLOOKUP. "E: I" should be "E:I".
Related
I have a pivot table to aggregate "coverage" on "part" only for accepted parts.
I want then to extract the "sum of coverage" to another sheet.
I wrote the following macro:
Sub Pull_data()
'Update the pivot table
Sheets("Pivot").PivotTables("PivotTable2").PivotCache.Refresh
'clear all filters
Sheets("Pivot").PivotTables("PivotTable2").PivotFields("Accepted").ClearAllFilters
'filters only accepted items
Sheets("Pivot").PivotTables("PivotTable2").PivotFields("Accepted").CurrentPage = "YES"
'get the last row of the pivot table
Set PT = Sheets("Pivot").PivotTables("PivotTable2")
With PT.TableRange1
lngLastRow = .rows(.rows.Count).Row
End With
For i = 4 To lngLastRow
'copy the coverage to destination sheet
NEWi = i + 10
Sheets("Destination").Range("G" & NEWi) = PivotTable.GetPivotData(data_field, Range("I" & i), “Coverage”)
Next i
End Sub
I get a run time error '424', object required on
Sheets("Destination").Range("G" & NEWi) = PivotTable.GetPivotData(data_field, Range("I" & i), “Coverage”)
Which would be the proper way to write that line?
This should be :
Sheets("Destination").Range("G" & i + 10).Value = _
pT.GetPivotData("Sum of coverage", "Part", Range("I" & i).Value).Value
Because pT.GetPivotData returns a Range!
Cleaned code :
Sub Pull_data()
Dim pT As PivotTable
Set pT = Sheets("Pivot").PivotTables("PivotTable2")
With pT
'''Update the pivot table
.PivotCache.Refresh
'''clear all filters
.PivotFields("Accepted").ClearAllFilters
'''filters only accepted items
.PivotFields("Accepted").CurrentPage = "YES"
'''get the last row of the pivot table
With .TableRange1
lngLastRow = .Rows(.Rows.Count).Row
For i = .Cells(2, 1).Row To lngLastRow
Debug.Print "i=" & i & "|" & Sheets("Pivot").Range("I" & i).Value
'''copy the coverage to destination sheet
Sheets("Destination").Range("G" & i + 10).Value = _
pT.GetPivotData("Sum of coverage", "Part", Sheets("Pivot").Range("I" & i).Value).Value
Next i
End With '.TableRange1
End With 'pT
End Sub
You could try copying the entire Column from your PivotTable after it's filtered to your needs, with TableRange2 , use the Resize to a single column, and then Copy and PasteSpecial xlValues to the destination worksheet.
If the code below takes the wrong column, you can also use the Offset(0,1) to get the right one.
With PT
.TableRange2.Resize(.TableRange2.Rows.Count, 1).Copy
Worksheets("Destination").Range("G14").PasteSpecial xlValues '<-- start Pasting from Row 14
End With
Note: if the code above takes the column to the left, try the code line below:
.TableRange2.Resize(.TableRange2.Rows.Count, 1).Offset(, 1).Copy
I'm currently trying to use VBA to copy some cells from one location to another and because I'm new to VBA I was wondering if anyone could help me make my code a bit more efficient I know there must be a way to copy to a cell without having to select the cell and then copy to it
For i = 1 To dataSheet.Range("A" & dataSheet.Rows.Count).End(xlUp).Row
dataSheet.Range("A" & i & ":" & "CT" & i).Copy
Set rCell = dataSheet.Range("C" & i)
pasteSheet.Activate
If rCell = condition1 Then
With ActiveSheet
.Range("CU" & rowLoop2).Select
ActiveSheet.paste
End With
You have 2 options. Either use the .PasteSpecial method, or you can just reference the original range and set the new range to it's value.
.Range("CU" & rowLoop2).PasteSpecial Paste:=xlPasteAll
With the setting values option, you have to define the whole range which the values should fill.
Range("A3:E3").Value = Range("A1:E1").Value
If you just used Range("A3").Value = Range("A1:E1").Value only cell A3 would be populated, and it would take th value from cell A1. Hope this helps.
Edit: it's worth noting that you do not have to change sheets to paste either. Your code could be amended to the below:
With dataSheet
For i = 1 To .Range("A" & .Rows.Count).End(xlUp).Row
.Range("A" & i & ":" & "CT" & i).Copy
Set rCell = .Range("C" & i)
If rCell = condition1 Then
pasteSheet.Range("CU" & rowLoop2).PasteSpecial Paste:=xlPasteAll
End If
Next i
End With
I tried adapting this post: Error in finding last used cell in VBA to my needs but couldn't quite get it to work.
I'm pasting data into a new worksheet and then want to select the first empty row after data. Currently what's happening is the data is pasted and then the very first row in the sheet is selected. See code below. Any thoughts?
'runs when user enters data
If Target.Cells.Count = 1 And _
Not Application.Intersect(Target, [I3:I10000]) Is Nothing Then
Application.EnableEvents = False
'User inputs type of event
Archive = InputBox("Was this event a Win, Loss, or Close? (Please input Win/Loss/Close)")
With Target
If Archive = "Win" Then
'all data to transfer is selected and cut
.EntireRow.Select
Selection.Cut
'the receiving sheet is selected and data is pasted to the selected cell
Sheets("Win").Select
ActiveSheet.Paste
'the selection on the sheet the data was cut from is deleted
Sheets("Begin").Select
Selection.Delete
'this is the issue I'm having - I want to select the row below the row I just copied into.
Sheets("Win").Select
lastRow = Range("C" & .Rows.Count).End(xlUp).Row
ActiveSheet.Range("C" & lastRow & ":C" & lastRow).EntireRow.Select
Sheets("Begin").Select
Try replacing this:
'this is the issue I'm having - I want to select the row below the row I just copied into.
Sheets("Win").Select
lastRow = Range("C" & .Rows.Count).End(xlUp).Row
ActiveSheet.Range("C" & lastRow & ":C" & lastRow).EntireRow.Select
with this:
With Sheets("Win")
lastRow = .Range("C" & .Rows.Count).End(xlUp).Row
.Cells(lastRow + 1, 1).EntireRow.Select
End With
Just to add to the existing answer. You can avoid doing so much selection by using a construction more like this:
On Error GoTo problem
Dim Archive As String
If (Target.Cells.Count = 1) And _
Not (Excel.Application.Intersect(Target, [I3:I10000]) Is Nothing) Then
Excel.Application.EnableEvents = False
'User inputs type of event
Archive = InputBox("Was this event a Win, Loss, or Close? (Please input Win/Loss/Close)")
With Target
'>>>> good idea to defend against users entering "win" instead of "Win"
If (LCase(Archive) = "win") Then
'>>>> find the last row in Win sheet at the beginning
With Sheets("Win")
lr = .Range("C" & .Rows.Count).End(Excel.xlUp).Row
End With
'>>>> as you are cutting there should be no need to do any subsequent deletion or clearcontents
.EntireRow.Cut Sheets("Win").Rows(lr + 1)
End If
End With
End If
problem:
Excel.Application.EnableEvents = True
I've written a macro to copy and insert rows or columns in different locations depending on an input string. The copy and insert locations are defined by Named Ranges within the spreadsheet.
If I want to add several columns in the same section, everything works great. If I add even one column in one section, then want to add a column in another section, I get one of two errors: Copy method of Range class failed OR Insert method of Range class failed
I haven't been able to figure out why sometimes the copy method throws an error and sometimes it doesn't. Any help would be greatly appreciated.
Code:
Sheets("TL Master").Range("Insert" & strAddType).Copy
'Offset for row/column
If strRowColumn = "row" Then
'Row = add value above
Range("Insert" & strAddType).Insert Shift:=xlDown
Range("Add" & strAddType & "ButtonCell").Offset(-4, 0).Value = strNewName
Else
'Column = add value left
Sheets("TL Master").Range("Insert" & strAddType).Insert Shift:=xlToRight
Range("Add" & strAddType & "ButtonCell").Offset(0, -4).Value = strNewName
If strAddType = "Machine" Then Range("Add" & strAddType & "ButtonCell").Offset(0, -4).Interior.Color = clrComplexityColor
End If
You code is missing the sheet name. For example -
Sheets("TL Master").Range("Insert" & strAddType).Copy
'Offset for row/column
If strRowColumn = "row" Then
'Row = add value above
Sheets("TL Master").Range("Insert" & strAddType).Insert Shift:=xlDown
Sheets("TL Master").Range("Add" & strAddType & "ButtonCell").Offset(-4, 0).Value = strNewName
Else
'Column = add value left
Sheets("TL Master").Range("Insert" & strAddType).Insert Shift:=xlToRight
Sheets("TL Master").Range("Add" & strAddType & "ButtonCell").Offset(0, -4).Value = strNewName
If strAddType = "Machine" Then Range("Add" & strAddType & "ButtonCell").Offset(0, -4).Interior.Color = clrComplexityColor
End If
The other thing I would make note of is if your Offset forces data to be pasted outside of the sheet this will cause an error. For example, if your named range is A1:A10 and you do and Offset(0, -1) this is off the sheet and causes an error.
Hope this helps.
My quote generator creates an Excel document and I want to run a macro on it to just keep it's calculations. For some reason it says 'Number stored as text' when there are numbers. How can I change them to the number format using the macro? I have found out if I click once in the formula bar, the problem is solved too.
The code below is what I have now, but it won't solve the error.
Range("A1:A" & LastRow).Select
Selection.NumberFormat = "0"
Column A contains an amount (1, 2, 3, etc). I have another column with the same problem, but this contains a currency in € and has 2 decimal places.
Range("I1:I" & LastRow).Select
Selection.NumberFormat = "0.00"
Thanks for your help! :)
Extra shoutout to Siddharth who helped me complete this complete issue.
Tom,
There are 3 ways to solve this
1) Go Back to your quote generator and see how it is saving the data to Excel Sheet and amend the code there
2) Manually: Highlight the Range and click on the exclamation mark next to the Green Triangle and click on "Convert to Number" See snapshot
3) Use this code.
Sub Sample()
Dim LastRow As Long, i As Long
LastRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Sheet1").Range("A1:A" & LastRow).NumberFormat = "0"
For i = 1 To LastRow
If Val(Sheets("Sheet1").Range("A" & i).Value) <> 0 Then _
Sheets("Sheet1").Range("A" & i).Formula = _
Val(Sheets("Sheet1").Range("A" & i).Value)
Next i
Dim temp As Double
LastRow = Sheets("Sheet1").Range("I" & Rows.Count).End(xlUp).Row
Sheets("Sheet1").Range("I1:I" & LastRow).NumberFormat = "\$#,##0.00"
For i = 1 To LastRow
If Val(Sheets("Sheet1").Range("I" & i).Value) <> 0 Then
temp = Sheets("Sheet1").Range("I" & i).Value
Sheets("Sheet1").Range("I" & i).ClearContents
Sheets("Sheet1").Range("I" & i).Value = temp
End If
Next i
End Sub
FOLLOW UP
Before and After snapshot attached
MORE FOLLOW UP (IMPORTANT)
If you have different regional settings then you will have to take care of them appropriately.
For Example Dutch Belgium you have to use "," for a decimal. Please see snapshot.
Try this different ways:-
Way 1
Selection.NumberFormat = "General"
Way 2
vStr = "1000.5"
intNum = CInt(vStr)
Way 3
Convert Text to Numbers With VBA
If you frequently convert text to numbers, you can use a macro.
Add a button to an existing toolbar, and attach the macro to that button. Then, select the cells, and click the toolbar button.
Sub ConvertToNumbers()
Cells.SpecialCells(xlCellTypeLastCell) _
.Offset(1, 1).Copy
Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlPasteSpecialOperationAdd
With Selection
.VerticalAlignment = xlTop
.WrapText = False
End With
Selection.EntireColumn.AutoFit
End Sub