I have this code running smoothly when I step through the code (F8), but when I run it with F5 or call it to run from a button it doesn't do what it's supposed to. It only does the lookup in the first cell (Q2) and leaves the rest blank - like it skipped to run the formula down to the last row.
How can I improve my code to make sure that it always runs as it should?
Sub LookupFilename()
' Looks up the filename to be set according to Team Name
Application.ScreenUpdating = False
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("Q2").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(VLOOKUP(RC[-3],Controller!C9:C12,4,FALSE),""Other"")"
Range("Q2").AutoFill Destination:=Range("Q2:Q" & LastRow)
Application.ScreenUpdating = True
MsgBox "Successful data collection.", vbInformation, "Success"
End Sub
There is no need to Select or use ActiveCell or AutoFill. Replace:
Range("Q2").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(VLOOKUP(RC[-3],Controller!C9:C12,4,FALSE),""Other"")"
Range("Q2").AutoFill Destination:=Range("Q2:Q" & LastRow)
with:
Range("Q2:Q" & LastRow).FormulaR1C1 = _
"=IFERROR(VLOOKUP(RC[-3],Controller!C9:C12,4,FALSE),""Other"")"
Note, you shouldn't be Activateing either. Instead, qualify your Range, Cells, and Rows calls with the appropriate worksheet. Note the . before Cells, Rows and Range below:
Dim Data As Worksheet
Set Data = ThisWorkbook.Worksheets("Data")
With Data
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("Q2:Q" & LastRow).FormulaR1C1 = _
"=IFERROR(VLOOKUP(RC[-3],Controller!C9:C12,4,FALSE),""Other"")"
End With
Related
In below code I need to copy a range from "Output for qualifying" and insert as values in "Output".
It works, but I need the code to stop copy the range when column A start to contain the value zero (0).
Is there a smart way to do that? Hope you guys can help me.
Sub Copy_to_output()
Worksheets("Output for qualifying").Range("A2:A400").Copy
Worksheets("Output").Range("A9").PasteSpecial Paste:=xlPasteValues
Worksheets("Output for qualifying").Range("B2:H400").Copy
Worksheets("Output").Range("E9").PasteSpecial Paste:=xlPasteValues
Worksheets("Output for qualifying").Range("J2:K400").Copy
Worksheets("Output").Range("L9").PasteSpecial Paste:=xlPasteValues
Worksheets("Output for qualifying").Range("Q2:Y400").Copy
Worksheets("Output").Range("N9").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End Sub
The only thing I can think of in your situation is to use the Find method.
So, in your code, find the first 0 value, then use that as your row reference for the copy. This is by no means a clean way for the operation, but will do the task.
Sub Copy_to_output()
Dim lZeroRow As Long
lZeroRow = Worksheets("Output for qualifying").Range("A:A").Find(What:="0", LookIn:=xlValues, LookAt:=xlWhole).Row
Worksheets("Output for qualifying").Range("A2:A" & lZeroRow).Copy
Worksheets("Output").Range("A9").PasteSpecial Paste:=xlPasteValues
Worksheets("Output for qualifying").Range("B2:H" & lZeroRow).Copy
Worksheets("Output").Range("E9").PasteSpecial Paste:=xlPasteValues
Worksheets("Output for qualifying").Range("J2:K" & lZeroRow).Copy
Worksheets("Output").Range("L9").PasteSpecial Paste:=xlPasteValues
Worksheets("Output for qualifying").Range("Q2:Y" & lZeroRow).Copy
Worksheets("Output").Range("N9").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End Sub
Try the next code, please:
Sub Copy_to_output()
Dim shOFQ As Worksheet, shO As Worksheet, lastRow As Long
Set shOFQ = Worksheets("Output for qualifying")
Set shO = Worksheets("Output")
lastRow = shOFQ.Range("A:A").Find(What:="0", LookIn:=xlValues, LookAt:=xlWhole).row
shO.Range("A9").Resize(lastRow, 1).Value = shOFQ.Range("A2:A" & lastRow).Value
shO.Range("E9").Resize(lastRow, shOFQ.Range("B2:H" & lastRow).Columns.Count).Value = shOFQ.Range("B2:H" & lastRow).Value
shO.Range("L9").Resize(lastRow, shOFQ.Range("J2:K" & lastRow).Columns.Count).Value = shOFQ.Range("J2:K" & lastRow).Value
shO.Range("N9").Resize(lastRow, shOFQ.Range("Q2:Y" & lastRow).Columns.Count).Value = shOFQ.Range("Q2:Y" & lastRow).Value
End Sub
No need to use Copy Paste...
Dim lastrow&, lastCol&, myarray As Range
lastrow = Range("A1").End(xlDown).Row
lastCol = Range("XX1").End(xlToLeft).Column
Set myarray = Range("A1").Resize(lastrow, lastCol)
Range("A1", myarray).Select
So i added the above code to recognise the last column and last row and copy the array
Selection.Copy
Application.CutCopyMode = False
Selection.Copy
Application.WindowState = xlNormal
Windows("Ex-Pakistan Calculator Final.xlsm").Activate
Sheets("MRG").Select
'has to find the last row by itself
Range("A" & Rows.Count).End(xlUp).Offset(2, 0).Select
ActiveSheet.Paste
Getting an error on the last line "activesheet.paste" saying copy and pasting area isn't the same size, try selecting one cell. enter image description here
Thing is, "Range("A" & Rows.Count).End(xlUp).Offset(2, 0).Select" does only select one cell, so I don't see the issue.
Following is an ideal way to copy and paste using range selection. You can change this code as per your requirement.
Sub CopyPaste()
Dim selectRange As range
Dim lastrow As Integer
Application.CutCopyMode = False
Sheets("Sheet1").Activate
lastrow = range("A1").End(xlDown).Row
Set selectRange = range("A1:A" & lastrow)
selectRange.Copy
Sheets("Sheet2").range("B1:B" & lastrow).PasteSpecial xlPasteAll
End Sub
Congrats on starting to use VBA. There's several things in your code that could use improvement. You want to avoid using select (a common beginner task). You also don't even need to move around your sheet, or even use copy/paste.
However, see below where I've broken up your code with some statements to stop and check where you're at. I think this will accomplish what you want, but also help you gain a better grasp of what you're doing (it's always a battle getting started!)
Keep battling.
Sub adfa()
Const turnOnStops As Boolean = True 'change to true or false to review code
Dim WS_Pull As Worksheet:
Set WS_Pull = ActiveSheet 'better to define this with actual sheet name
Dim lastrow As Long:
lastrow = WS_Pull.Cells(Rows.Count, 1).End(xlUp).Row 'this assumes column a has the bottom row and no rows hidden
If turnOnStops Then
Debug.Print "Lastrow is " & lastrow
Stop
End If
Dim lastcol As Long:
lastcol = WS_Pull.Cells(1, Columns.Count).End(xlToLeft).Column 'same assumptions but with columns on row 1 instead of columna a
If turnOnStops Then
Debug.Print "lastcol is " & lastcol
Stop
End If
Dim myarray As Range:
Set myarray = WS_Pull.Range("A1").Resize(lastrow, lastcol) ' I'm not sure what you're trying to do here.
If turnOnStops Then
Dim theAnswer As Long
theAnswer = MsgBox("The address of myArray is " & myarray.Address & ". Stop code?", vbYesNo)
If theAnswer = vbYes Then Stop
End If
Dim WS_paste As Worksheet: Set WS_paste = Sheets("MRG") 'it would be better to use the SHEET (shown in the VBA project)
WS_Pull.Range("A1", myarray).Copy '<--- what are trying to copy.
If turnOnStops Then
theAnswer = MsgBox("The area copied was " & WS_Pull.Range("A1", myarray).Address & ". Stop code?", vbYesNo)
If theAnswer = vbYes Then Stop
End If
If turnOnStops Then
theAnswer = MsgBox("The area you are going to paste to is " & _
WS_paste.Cells(1, Rows.Count).End(xlUp).Offset(2, 0).Address & " stop code?", vbYesNo)
If theAnswer = vbYes Then Stop
End If
End Sub
PasteValues is the most frustrating thing in VBA! Could greatly use some help.
In short, I am trying to copy one row and pastespecial values that row into another row on a separate sheet. I thought it was a row issue, so I then modified my range and tried pasting that, also to no avail. I even tried recording a macro and the generated code is almost the exact same as mine.
Can someone please help? I've been looking at this too long :/
Sub CopyXs()
Dim counter As Double
Dim CopyRange As String
Dim NewRange As String
counter = 2
For Each Cell In ThisWorkbook.Sheets("LD_Tracker_CEPFA").Range("A7:A500")
If Cell.Value = "X" Then
Sheets("Upload_Sheet").Select
matchrow = Cell.Row
counter = counter + 1
Let CopyRange = "A" & matchrow & ":" & "Y" & matchrow
Let NewRange = "A" & counter & ":" & "Y" & counter
Range(CopyRange).Select
Selection.Copy
Sheets("Final_Upload").Select
ActiveSheet.Range(NewRange).Select
Selection.PasteSpecial Paste = xlPasteValues
Sheets("Upload_Sheet").Select
End If
Next
End Sub
I was struggling also with Paste.Special. This code works for me. The code you get when you record a macro for Paste.Special is not working. You first have to define a range and then used the code for Paste.Special
Range(something).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'This code works for me:
'**Select everything on the active sheet**
Range("A1").Select
Dim rangeTemp As Range
Set rngTemp = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
If Not rngTemp Is Nothing Then Range(Cells(4, 1), rngTemp).Select
End if
' **Copy the selected range**
Selection.Copy
'**Select the destination and go to the last cel in column A and then go 2 cells down
'and paste the values**
Sheets("your sheet name").Select
Range("A" & Cells.Rows.Count).End(xlUp).Offset(2, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
**'Select the last cell in column A**
Range("A" & Cells.Rows.Count).End(xlUp).Select
I have some formulas in a row. I want to copy them down to the end of the rest of my data.
When using normal formulas, the following code works:
With Sheets("Sheet1")
Set formRange = Range(.Range("G2"), .Range("O2").End(xlToRight))
formRange.Copy
formRange.Resize(Range("D" & Rows.Count).End(xlUp).Row - 1).PasteSpecial Paste:=xlPasteFormulas
Application.CutCopyMode = False
.Range("A1").Select
End With
However, when I replace some formulas with array formulas, I get a Run-time error 1004 that says PasteSpecial method of Range class failed.
Is there any way around this?
As commented, you cannot change part of an array. So try this:
Dim formRange As Range, arrForm As String
With Sheets("Sheet1")
Set formRange = Range(.Range("G2"), _
.Range("O2").End(xlToRight))
arrForm = formRange.FormulaArray
formRange.ClearContents
formRange.Resize(.Range("D" & _
.Rows.Count).End(xlUp).Row - 1).FormulaArray = arrForm
End With
Btw, take note of the extra dots I put in this line:
formRange.Resize(.Range("D" & _
.Rows.Count).End(xlUp).Row - 1).FormulaArray = arrForm
I assumed that you are pertaining to D Column of the same sheet.
Above works if it is just one array formula output in several ranges.
If each cell has different array formula, then just add offset in your code like this:
With Sheets("Sheet1")
Set formRange = Range(.Range("G2"), _
.Range("O2").End(xlToRight))
formRange.Copy
formRange.Offset(1, 0).Resize(.Range("D" & _
.Rows.Count).End(xlUp).Row - 1).PasteSpecial xlPasteFormulas
End With
You need to use the Range.FormulaArray method:
With Worksheets("Sheet1")
Set formRange = Range(.Range("G2"), .Range("O2").End(xlToRight))
formRange.Copy
Set newRange = (Range("D" & Rows.Count).End(xlUp).Row - 1)
newRange.FormulaArray = formRange
Application.CutCopyMode = False
.Range("A1").Select
End With
I am using VBA to run a set of data against five "rule" columns stored in another sheet in the workbook. Put simply, I seem to have code which works, but the VBA use of Selection.Formula = returns "False" when an cell formula would return #N/A or #VALUE. It's critical that I get the error values because it tells the user something different than "False". False should mean that column C (see picture of calculation tab below) doesn't pass the rule. The error values mean that either column B is not found with VLookup in the Rules column or the rule was written incorrectly.
Here's what I have so far:
Sub Build_Formulas_v2()
Application.Calculation = xlManual
Range("a2", Range("a65536").End(xlUp)).Offset(0, 6).Select
Selection.Value = _
Evaluate("(""=""&SUBSTITUTE(VLOOKUP(B2,'Logic Statements'!A:E,4,FALSE),""ZZZ"",""c""&ROW()))")
End Sub
Any help would be tremendously appreciated - my VBA knowledge is still growing and is too basic to understand what I'm up against.
I believe you are using Excel 2003. You should never hard code values like A65536. You can get undesirable results in xl2007+ as they have 1048576 rows.
Is this what you are trying?
Sub Build_Formulas_v2()
Dim lRow As Long
Dim ws As Worksheet
Application.Calculation = xlManual
'~~> Change this to the relevant sheet
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("A2:A" & lRow).Offset(0, 6).Formula = _
"=SUBSTITUTE(VLOOKUP(B2,'Logic Statements'!A:E,4,FALSE),""ZZZ"",""c""&ROW())"
'~~> Uncomment the below in case you want to replace formulas with values
'.Range("A2:A" & lRow).Offset(0, 6).Value = .Range("A2:A" & lRow).Offset(0, 6).Value
End With
End Sub
Or if you do not want to use .Offset, then you can directly address Column G
Sub Build_Formulas_v2()
Dim lRow As Long
Dim ws As Worksheet
Application.Calculation = xlManual
'~~> Change this to the relevant sheet
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("G2:G" & lRow).Formula = _
"=SUBSTITUTE(VLOOKUP(B2,'Logic Statements'!A:E,4,FALSE),""ZZZ"",""C""&ROW())"
'~~> Uncomment the below in case you want to replace formulas with values
'.Range("A2:A" & lRow).Offset(0, 6).Value = _
.Range("A2:A" & lRow).Offset(0, 6).Value
End With
End Sub