I am using the below code for copying the value of corresponding cell depending on value of another cell but i am getting the error 91. can you please see what i am doing wrong. getting error on
Dim ws As Worksheet, Snags As Worksheet
Dim lr As Long, lrSnags As Long, i As Long
Application.ScreenUpdating = False
For Each ws In Worksheets
If ws.Name <> "Snags" Then
lr = ws.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To lr
lrSnags = Snags.Range("A" & Rows.Count).End(xlUp).Row + 1
If ws.Range("B") = "Fail" Then
ws.Range("A" & i).Copy
Snags.Range("A" & lrSnags).PasteSpecial xlPasteValues
End If
Next i
End If
Next ws
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Complete"
End Sub
getting error at below line
lrSnags = Snags.Range("A" & Rows.Count).End(xlUp).Row + 1
I would guess you did not define your worksheet named "Snags"
You need to set Snags after defining it:
For ex with:
Set Snags = Worksheets("Snags")
Alternatively you can just change your line without defining it to:
lrSnags = Sheets("Snags").Range("A" & Rows.Count).End(xlUp).Row + 1
Related
Okay, so I feel like I am getting closer but I am running in to an object error. I am trying to replace old values in an excel sheet with the new charge values. Here is an example of what I am trying to do.
This is an example of the type of table I might start out with.
This is what I want it to look like after I run the VBA
Here is what I have so far.
Sub Testing()
Dim x As Integer
Dim UpdateRng As Range
Dim SelectRng As Range
v = 2
Application.ScreenUpdating = False
' Get count
NumRows = Range("B2", Range("B2").End(xlDown)).Rows.Count
Range("B2").Select
' Cycle through loop
For x = 1 To NumRows
Set SelectRng = Range("C" & v & ":" & "F" & v) 'Set range
If "A" & v.Vaule = " " Or v.Value = "" Then GoTo NextV
For Each UpdateRng In SelectRng
If UpdateRng.Value > 0 Then
UpdateRng.Value = Range("A" & v).Value
End If
Next
NextV:
v = v + 1
Next
Application.ScreenUpdating = True
End Sub
Add Option Explicit to the top of the module and declare all variables.
Avoid using GoTo as that generally creates spaghetti code.
Use End(xlUp) to determine the last row.
Avoid using Select.
Use Long instead of Integer.
Sub Testing()
Dim ws As Worksheet
Set ws = ActiveSheet
With ws
Dim lastRow As Long
lastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
End With
Dim i As Long
For i = 2 To lastRow
With ws
If Not IsEmpty(.Range("A" & i).Value) Then
.Range("C" & i & ":F" & i).Replace "*", .Range("A" & i).Value
End If
End With
Next
End Sub
Note that this considers all values when replacing, not just values greater than 0. Though I think the >0 check is essentially checking if the cells in columns C:F are not empty.
I got it working with this. However, Bigben's is much cleaner.
Sub Testing()
Dim x As Integer
Dim UpdateRng As Range
Dim SelectRng As Range
v = 2
Application.ScreenUpdating = False
' Get count
NumRows = Range("B2", Range("B2").End(xlDown)).Rows.Count
Range("B2").Select
' Cycle through loop
For x = 1 To NumRows
Set SelectRng = Range("C" & v & ":" & "F" & v) 'Set range
If Range("A" & v).Value = " " Or Range("A" & v).Value = "" Then GoTo NextV
For Each UpdateRng In SelectRng
If UpdateRng.Value > 0 Then
UpdateRng.Value = Range("A" & v).Value
End If
Next
NextV:
v = v + 1
Next
Application.ScreenUpdating = True
End Sub
I'm trying to go through a column and increment each value by one until it's empty but I get a run time error:
Run-time error '13': Type mismatch
Please help.
Private Sub CommandButton1_Click()
Start = Val(Range("H2").Value)
LastRow = Cells(Rows.Count, 8).End(xlUp).Row
For Row = 2 To LastRow
If Not IsEmpty(Range("H" & Row)) Then
Range("H" & Row).Value = Range("H" & Row).Value + 1
End If
Next
End Sub
Here's some untested code that should isoluate your issue. The way you set your range up is a little strange. Give this a try.
Dim ws As Worksheet: Set ws = ActiveSheet 'i assume this is correct
Dim r As Long
Dim cNumber As Long
cNumber = Range("h2").Column 'just for illustration
For r = 2 To ws.UsedRange.Cells(ws.UsedRange.Rows.Count, 1).Row
If Not IsEmpty(ws.Cells(r, cNumber)) Then
If IsNumeric(ws.Cells(r, cNumber)) Then
ws.Cells(r, cNumber).Value = ws.Cells(r, cNumber).Value + 1
Else
'cell is not empty but does not have a numeric value
'Stop
End If
Else
Exit For 'ends the loop
End If
Next r
Sorry for all the questions recently but I am quite new to VB. In my script that I have, when I run it on an empty sheet, it runs perfectly. However, when I try to run it to populate a table with those same values, it puts huge spaces in between all the values. Is there something I am forgetting to put in the script itself?
Code
For Each i In ddg
Unit = "Unit #" & i
LastRow = Sheets("Test").Range("A50000").End(xlUp).Row + 1
Sheets(Unit).Range("A2:A100").Copy Destination:=Sheets("Test").Range("A" & LastRow)
Sheets(Unit).Range("B2:B100").Copy Destination:=Sheets("Test").Range("D" & LastRow)
Sheets(Unit).Range("C2:C100").Copy Destination:=Sheets("Test").Range("E" & LastRow)
Sheets(Unit).Range("D2:D100").Copy Destination:=Sheets("Test").Range("F" & LastRow)
Sheets(Unit).Range("E2:E100").Copy Destination:=Sheets("Test").Range("G" & LastRow)
Sheets(Unit).Range("F2:F100").Copy Destination:=Sheets("Test").Range("L" & LastRow)
Next i
It looks like you are trying to copy values form one sheet to another sheet, based on a specific criteria. Your code seems weird. You know you need to fully qualify your from sheet, right. Try it like this.
Sub Copy_If_Criteria_Met()
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
I = Worksheets("Sheet1").UsedRange.Rows.Count
J = Worksheets("Sheet2").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("Sheet1").Range("A1:A" & I)
On Error Resume Next
Application.ScreenUpdating = False
For Each xCell In xRg
If CStr(xCell.Value) = "X" Then
xCell.EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
xCell.EntireRow.Delete
J = J + 1
End If
Next
Application.ScreenUpdating = True
End Sub
Please help - I've been searching for hours and am having no luck!
I'm using Power Query to bring in results from a SQL script. This information updates everytime I open the spreadsheet. Once the information has updated, I would like to delete Rows which have a date in Column C that is greater than today, so they don't get calculated in my VLOOKUP on another sheet.
I've tried the following:
Private Sub Workbook_Open()
Dim LR As Long, I As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
LR = Range("C" & Rows.Count).End(xlUp).Row
For I = LR To 1 Step -1
If Range("C" & I).Value > Date Then Rows(I).Delete
Next I
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
This however doesn't run automatically, and when running it manually it gives "Run-time error '1004': Application-defined or object-defined error" and then proceeds to delete incorrect dates.
I also tried this, but it also deletes the incorrect dates and gives me Run-time error.
Sub DeleteCells()
Dim LR As Long, I As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
LR = Range("C" & Rows.Count).End(xlUp).Row
For I = LR To 1 Step -1
If Range("C" & I).Value > Date Then Rows(I).Delete
Next I
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
EDIT 4/11: I am guessing that the 1004 error occurred because all of the "Branch Not Open" rows had been previously removed. The updated code below wraps an if statement around the autofilter step, which should now only be applied if at least one match for "Branch Not Open" is found in the filter range. Hopefully this version works!
#SickDimension is off to a great start -- but since you know that a number of rows are going to have "Branch Not Open" listed in the "Live Date" column you can remove them quickly using the autofilter. Try this code out (with an update for the LR code too):
Private Sub Workbook_Open()
Dim LR As Long, LC As Long, I As Long
Dim FilterRng As Range
Dim DataSheet As Worksheet
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'assign worksheet to save time in references
Set DataSheet = ThisWorkbook.Worksheets("Clocking Exceptions")
'Define your filter range as the block of data
LC = DataSheet.Range("A3").End(xlToRight).Column
With DataSheet
LR = .Range("C" & .Rows.Count).End(xlUp).Row
End With
Set FilterRng = Range(DataSheet.Cells(3, 1), DataSheet.Cells(LR, LC))
'autofilter the sheet to remove "Branch Not Open" rows
If Not FilterRng.Find(What:="Branch Not Open", LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
With FilterRng
.AutoFilter Field:=3, Criteria1:="Branch Not Open", Operator:=xlAnd
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
DataSheet.AutoFilterMode = False
End If
For I = LR To 1 Step -1
If IsDate(DataSheet.Range("C" & I).Value) Then
If DateValue(DataSheet.Range("C" & I).Value) > DateValue(Date) Then Rows(I).Delete
End If
Next I
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
If you need to use it upon opening file, you should specify the sheet you want it to run as upon opening file there is no range/sheet selected there for error '1004' ;) for ex.
'Following line needs to be defined more accurately
Range("C" & I).Value
'Redefine
Sheets("Sheet1").Range("C" & I).Value
Other wise the following will work, add the DateValue() to make the comparioson with the date values -
If DateValue(Range("C" & I).Value) > DateValue(Date) Then Rows(I).Delete
The solution
Private Sub Workbook_Open()
Dim LR As Long, I As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
LR = Sheets("Sheet1").Range("C" & Rows.Count).End(xlUp).Row
For I = LR To 1 Step -1
If IsDate(Sheets("Sheet1").Range("C" & I).Value) Then
If DateValue(Sheets("Sheet1").Range("C" & I).Value) > DateValue(Date) Then Rows(I).Delete
End If
Next I
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
I decided to change my tact.
I decided to take another shot at this, but in a new way. I did a weekend long Google marathon and found I believe my answer,
Option Explicit
Sub DataUpdate()
Dim rFind As Long, NR As Long, LR As Long, LC As Long
LR = Range("C" & Rows.Count).End(xlUp).Row
LC = Cells(2, Columns.Count).End(xlToLeft).Column
NR = LR + 1
On Error Resume Next
rFind = Range("A25:A" & LR).Find(Range("A1")).Row
On Error GoTo 0
If rFind = 0 Then
If MsgBox("Customer record not found, add to dataset?", vbYesNo + vbQuestion) = vbYes Then
Range("A2", Cells(LC, 2)).Copy
Range("C" & NR).PasteSpecial xlPasteValues
Range("A1", Cells(1, LC)).ClearContents
Exit Sub
End If
Else
Range("A2", Cells(2, LC)).Copy
Range("A" & rFind).PasteSpecial xlPasteValues
Range("A1", Cells(1, LC)).ClearContents
End If
End Sub
Looking at this I just want a cleaner explanation instead of just taking it as is, and using it without knowing what I am doing.
Here is the sheet it is on:
http://dl.dropbox.com/u/3327208/Excel/Replace.zip
If I add this to my code, regurgitate this code I see I can do this, I just want to verify that this is correct.
Option Explicit
Sub PENCMR()
Dim i As Integer
With Application
.ScreenUpdating = False
End With
'Internal NCMR
Dim wsPE As Worksheet
Dim wsNDA As Worksheet
'Copy Ranges
Dim c As Variant
'Paste Ranges
Dim p As Range
'Setting Sheet
Set wsPE = Sheets("Print-Edit NCMR")
Set wsNDA = Sheets("NCMR Data")
Set p = wsPE.Range("A54:U54")
With wsPE
c = Array(.Range("AG2"), .Range("B11"), .Range("B14"), .Range("B17"), .Range("B20"), .Range("B23") _
, .Range("Q11"), .Range("Q14"), .Range("Q17"), .Range("Q20"), .Range("R25"), .Range("V23") _
, .Range("V25"), .Range("V27"), .Range("B32"), .Range("B36"), .Range("B40"), .Range("B44") _
, .Range("D49"), .Range("L49"), .Range("V49"))
End With
For i = LBound(c) To UBound(c)
p(i + 1).Value = c(i).Value
Next
With wsNDA
Dim rFind As Long, NR As Long, LR As Long, LC As Long
LR = Range("C" & Rows.Count).End(xlUp).Row
LC = Cells(2, Columns.Count).End(xlToLeft).Column
NR = LR + 1
rFind = wsNDA.Range("A:A" & LR).Find(Range("A54")).Row
Range("A54", Cells(2, LC)).Copy
Range("A" & rFind).PasteSpecial xlPasteValues
Range("A54", Cells(1, LC)).ClearContents
End With
With Application
.ScreenUpdating = True
End With
End Sub
The code runs, but it doesn't come back with an error, yet it doesn't run completely. It hits to the point where it drags everything down, then it seems to die there. Can someone help me find out why it doesn't do what I think it should do, which is copy the row, search for the number in column A, and then write over it with the correct data in row 54...
I know something is wrong, but I don't have the skills to figure out what, if someone can help me it be greatly appreciated.
I am not 100% sure of what you are trying to achieve but there are several problems in your code:
Instead of
Set p = wsPE.Range("A54:U54")
For i = LBound(c) To UBound(c)
p(i + 1).Value = c(i).Value
Next
You probably mean
Set p = wsPE.Range("A54")
For i = LBound(c) To UBound(c)
p.Offset(0, i) = c(i)
Next
In your With wsNDA block, you need to put . before the Range and Cells, for example:
.Range("A54", .Cells(2, LC)).Copy
Finally:
I would remove the ScreenUpdating statements for now, and run the code in debug mode (F8) to see step by step what the code is doing and check the values of your variables if necessary use "Add Watch"
I would avoid using a range to store temporary data. You could use a 2D array instead, like this for example:
Dim data As Variant
Redim data(1 To 1, 1 To 21) As Variant
for i = xx To yy
data(1,i+1) = c(i)
Next i
yourTargetCell.Resize(1, UBound(data,2)) = data