Not sure if I did the code correctly but it is there.
My quandary is this line ws.Range("B" & J, Range("K" & J)).copy. It is giving me a Run-time error 1004 Method range of object worksheet failed.
What I am trying to do is copy/paste any row b:k if column "P" indicated "recorded".
Your assistance is greatly appreciated. Thank you.
Sub Clear_Recorded()
Dim ws As Worksheet
Dim ws1 As Worksheet
Dim lRow As Integer 'Data Tab
Dim count As Integer
Set ws = Sheet1 'Data
Set ws1 = Sheet11 'Archive
count = 0
lRow = ws.Range("B" & Rows.count).End(xlUp).Row
For J = 2 To lRow
If ws.Range("P" & J).Value = "Recorded" Then
count = count + 1
ws.Range("B" & J, Range("K" & J)).copy
ws1.Range("A" & count).PasteSpecial
End If
Next J
You just need to get rid of the second "Range" and the extra parenthesis. Hope this helps!
ws.Range("B" & J, "K" & J).Copy
Edit: Spelling
You are trying to set a worksheet object without referencing any kind of sheet.
How to fix this issue:
set ws = Thisworkbook.Sheets("SheetName")
Also you should rather use this:
if ws.Range("P2").Offset(J-1) = "Recorded" then
'Rest of code goes here
.Offset has the parameters RowOffset ,ColumnOffset
This should solve your problem.
Related
I need column J to be filled with the value 1 in all cells until the rows that are filled in column A. Could someone provide me with the vba code for the same? Thanks in advance.
If you want to autofill 2010 until the row of column B with value 1:
Sub test()
Dim lastrow As Long
lastrow = Range("B" & Rows.Count).End(xlUp).Row
Range("A2:A" & lastrow).Value = 2010
End Sub
Give a try on below codes-
Sub FillCells()
Dim lr As Long, i As Long
Dim rng As Range
lr = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To lr
Cells(i, "J") = 1
Next i
End Sub
Please, try the next code line:
Range("J2:J" & Range("A" & rows.count).End(xlUp).row).Value = 1
Edited
You asked in a comment to another answer something about doing it for specific sheets.
Please, try the next way:
Dim ws As Worksheet, i As Long
For i = 2 To 5
Set ws = ActiveWorkbook.Worksheets(i)
ws.Range("J2:J" & ws.Range("A" & ws.rows.count).End(xlUp).row).Value = 1
Next i
Hope you're doing great, need help with below code that is supposed to match first column from 2 files then vlookup and copy paste the matched results. the problem is that i'm limited by vlookup range that only works for one column so i tried to make a loop to make it work on multiple number of cells as shown below but it's not working, any help or hints would be really welcomed, Thanks.
edit
the problem lies where iis used in the funcStr for the vlooukp table range and column's number, i need the range to be increased and column number to constinatly change to get the whole row copied instead.
Sub solution()
Dim oldRow As Integer
Dim newRow As Integer
Dim lrow_output As Integer
Dim WB_Input As Workbook
Dim WB_Output As Workbook
Dim WS_Input As Worksheet
Dim WS_Output As Worksheet
Dim funcStr As String
Dim i As Integer
Set WB_Input = Workbooks("File.xlsm")
Set WB_Output = Workbooks("output1.xlsx")
Set WS_Input = WB_Input.Worksheets("input")
Set WS_Output = WB_Output.Worksheets("Sheet1")
With WS_Output
lrow_output = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
For i = 2 To 6
With WS_Input
funcStr = "=IFERROR(VLOOKUP(" & Cells(1, 1).Address(False, False) & "," & "'[" & WB_Input.Name & "]" & .Name & "'!" & Range(.Columns(1), .Columns(i)).Address & ",i,0),"""")"
End With
With WS_Output
.Cells(1, i).Formula = funcStr
.Cells(1, i).Copy
Range(.Cells(1, i), .Cells(lrow_output, i)).PasteSpecial xlPasteFormulas
WS_Output.Calculate
Range(.Cells(1, i), .Cells(lrow_output, i)).Copy
Range(.Cells(1, i), .Cells(lrow_output, i)).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With
Next i
End Sub
Am I missing something here? I'm getting a 1004 during debug
Sub perc()
Dim lastRow As Long
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("G2:G" & lastRow).Formula = "=IF((AND(A2<>"",F2>0)),F2/C2, "")"
End Sub
You need to qualify your objects - What workbook/worksheet does the Range and Rows object exist on? The assumed object references may be incorrect
You need to double up on your blank quote strings inside the formula
Sub Perc()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim lr As Long
lr = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
ws.Range("G2:G" & lr).Formula = "=IF((AND(A2<>"""", F2>0)), F2/C2, """")"
End Sub
I am having difficulty in making comparison and replacing value in excel. It would be great if someone can help me out and guide me.
There are ticket no's in both the sheets. I would like to compare ticket number, if they matches then copy type and subtype from sheet1 to sheet2 type and subtype column. I am attaching image for your reference
If you would like to use VBA, this may help you:
Option Explicit
Sub test()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim ws1LastRow As Long, i As Long, ws2LastRow As Long, y As Long
Dim ws1TicketNo As String, ws2TicketNo As String, ws1Type As String, ws2Type As String, ws1SubT As String, ws2SubT As String
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set ws2 = ThisWorkbook.Worksheets("Sheet2")
ws1LastRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
ws2LastRow = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row
For i = 2 To ws1LastRow
ws1TicketNo = ws1.Range("A" & i).Value
ws1Type = ws1.Range("B" & i).Value
ws1SubT = ws1.Range("C" & i).Value
For y = 2 To ws2LastRow
ws2TicketNo = ws2.Range("A" & i).Value
ws2Type = ws2.Range("B" & i).Value
ws2SubT = ws2.Range("C" & i).Value
If ws1TicketNo = ws2TicketNo Then
ws2.Range("B" & i).Value = ws1Type
ws2.Range("C" & i).Value = ws1SubT
Exit For
End If
Next y
Next i
End Sub
Sheet 1:
Sheet 2:
Result:
You can use VLOOKUP function.
With that formula, you can search each ticket number from sheet2, search the info in sheet1 and return the value you want (type or subtype).
Something like =VLOOKUP(A2;Sheet1!$A$2:$B$4;2;FALSE) should work for you. adap it to your needs
Need some assistance. I have a template that gets data exported into it from a different program. The rows of data varies from export to export and a new workbook is needed for each export.
I, currently, have a 'Master' macro written that cleans up the worksheet (formats, text to numbers, etc.) and also adds checkboxes to the end of each row that contains data. These checkboxes are linked to a cell. Once the operator completes the worksheet, they will then need to check a checkbox for each row of data that is 'out of spec'. These rows will then be copied onto the next sheet in the workbook. This is triggered by a button. My current macro works other than copying the entire row of data when I only want to copy over cells in columns 'A' through 'I'. Cells in columns 'J' and out contain data that does NOT need to be copied.
Here is my current macro that, like I said, copies the entire row:
Sub CopyRows()
Dim LRow As Long, ChkBx As CheckBox, WS2 As Worksheet
Set WS2 = Worksheets("T2 FAIR (Single Cavity)")
LRow = WS2.Range("A" & Rows.Count).End(xlUp).Row
For Each ChkBx In ActiveSheet.CheckBoxes
If ChkBx.Value = 1 Then
LRow = LRow + 1
WS2.Cells(LRow, "A").Resize(, 14) = Range("A" & _
ChkBx.TopLeftCell.Row).Resize(, 14).Value
End If
Next
End Sub
In the right-side of your equation, your Range() object is not properly qualified (with a worksheet). So, I used the fake wsX in this example.
Also, I used the ending column of "D" - but you can change to whatever you need it to be.
LRow = LRow + 1
r = ChkBx.TopLeftCell.Row
ws2.Range(ws2.Cells(LRow, "A"), ws2.Cells(LRow, "D")) = wsX.Range( _
wsX.Cells(r, "A"), wsX.Cells(r, "D"))
or
ws2.Range("A" & LRow & ":D" & LRow) = wsX.Range("A" & r & ":D" & r)
From Comment:
The templates ALWAYS start, with the imported data, in "A19". When I run this macro, to copy the checked data to the next worksheet, it starts in with cell "A18". I have no idea as to why. How do I specify that the checked data is to be copied starting with "A19" on the next worksheet?
If it's always off by one, you can just add 1. I am not sure how your layout is, so this will be something you will have to either add to LRow or r. So either
ws2.Range("A" & LRow + 1 & ":D" & LRow + 1) = ...
or
... = wsX.Range("A" & r + 1 & ":D" & r + 1)
Answer is as follows:
Sub CopyRows()
Dim ws1 As Worksheet
Set ws1 = Worksheets("T1 FAIR (Single Cavity)")
Dim ws2 As Worksheet
Set ws2 = Worksheets("T2 FAIR (Single Cavity)")
Dim LRow As Long
LRow = ws2.Range("A" & rows.count).End(xlUp).row
Dim r As Long
Dim ChkBx As CheckBox
For Each ChkBx In ws1.CheckBoxes
If ChkBx.value = 1 Then
LRow = LRow + 1
r = ChkBx.TopLeftCell.row
ws2.Range("A" & LRow + 1 & ":I" & LRow + 1).value = _
ws1.Range("A" & r & ":I" & r + 1).value
End If
Next
End Sub