i have been having problems with getting my code to run through its conditional loop and stopping. Here is what I have:
Do While True
Dim i As Integer
i = 2
If Cells(i, 1).Value <> "" And Not IsError(Cells(i, 2).Value) Then
Range(Cells(i, 1), Cells(i, 22)).Copy
Range(Cells(i, 1), Cells(i, 22)).PasteSpecial
i = i + 1
Else
Exit Do
End If
Loop
What I'm trying to do is to get the program to check if one cells isn't empty and if another doesn't have an error in it, if that condition is met, then the program would copy a certain row and re-paste it as just it's values since some of the cells in the row is a formula. For some reason the loop doesn't exit and Excel crashes, am I missing something?
the i = 2 should be outside
Dim i As Integer
i = 2
Do While True
If Cells(i, 1).Value <> "" And Not IsError(Cells(i, 2).Value) Then
Range(Cells(i, 1), Cells(i, 22)).Copy
Range(Cells(i, 1), Cells(i, 22)).PasteSpecial
i = i + 1
Else
Exit Do
End If
Loop
Two points :
The i = 2 must be outside the while loop.
Don't use Copy and PasteSpecial. Using the clipboard will give lots of problems later on. Additionally PasteSpecial likes you to be specific with "what" PasteSpecial action you're using. Rather assign values directly.
Dim i As Integer, Dataset As Variant
i = 2
Do While True
If Cells(i, 1).Value <> "" And Not IsError(Cells(i, 2).Value) Then
'This seems silly, but it overwrites the cell with its value.
Dataset = Range(Cells(i, 1), Cells(i, 22)).Value
Range(Cells(i, 1), Cells(i, 22)).Value = Dataset
i = i + 1
Else
Exit Do
End If
Loop
Related
I'm trying to implement a nested for and a nested if statement together. I have the following column below. It needs to look at the column if the range is between 500-1000 it should give recommendation a (i.e. write the recommendation in another column) if it is more than 1000 it should give another recommendation in the responding column.
Income Recommendation
550 a
1200 b
750 a
1400 b
600 a
Dim i As Integer
Dim j As Integer
For i = 2 To Range(i, 1).End(xlDown).Row
If Cells(i, 1).Value > 1000 Then
Cells(i, 10).Value = "b"
i = i + 1
Else
If Cells(i, 1).Value < 1000 Then
If Cells(i, 1).Valie > 500 Then
Cells(i, 10).Value = "a"
End If
End If
i = i + 1
End If
Next i
End Sub
Several errors:
Don't rely on i having a value while it is setting the start and end values of the For loop - there is a good chance that it is 0 while calculating Range(i, 1). (Edit: Tested and confirmed that it is still 0 at the point when the end value is being calculated.) Using Range(0, 1) will give a 1004 error.
Don't increment the loop counter within the loop (i.e. don't do i = i + 1) - it will almost certainly confuse things. If you really only want to process every second row, use Step 2 on the For statement.
.Valie should be .Value
Don't use Integer data types for rows - these days Excel can handle 1048576 rows, which is more than an Integer can cope with.
Range(1, 1) is invalid syntax. When passing two parameters to the Range property, they need to be cell references. Passing a row and column is what is used when using the Cells property. (So Range(1, 1) will need to be Cells(1, 1), or Range("A1").)
Refactoring your code would give:
Dim i As Long
For i = 2 To Cells(1, "A").End(xlDown).Row
If Cells(i, "A").Value > 1000 Then
Cells(i, "J").Value = "b"
ElseIf Cells(i, "A").Value > 500 Then
Cells(i, "J").Value = "a"
Else
Cells(i, "J").Value = ""
End If
Next i
End Sub
You can do it like this with Select Case:
Public Sub TestMe()
Dim i As Long
Dim j As Long
With ActiveSheet
For i = 2 To .Cells(1, 1).End(xlDown).Row
Select Case True
Case .Cells(i, 1) > 1000
.Cells(i, 10) = "b"
Case .Cells(i, 1) < 1000 And .Cells(i, 1) > 500
.Cells(i, 10).value = "a"
End Select
Next i
End With
End Sub
It is more visible and a bit more understandable. Also, make sure that you refer to the Worksheet (in this case with ActiveSheet), to avoid reference problems in the future.
Right now, my code keeps coming up with an error when I try to run it or test it with an "Invalid use of Property" message. When I run it, the program highlights the line "Sub Update_Audit()"
In my code, I'm trying to manipulate data for an audit between 3 sheets in a workbook.The first block of my code is to paste the data of items I need to find for the audit from the original sheet onto the 3rd sheet by setting each row equal to the data of the original row in the first sheet. The second block is used to re-paste the data of found objects in the Audit to only have values rather then formulas.Then the code will iterate through the Audit list to check for the same values and delete those values on the list in the 3rd sheet. The 2nd sheet will have the list of found audit items being pasted in at the same time. The end result is 3 sheets, 1st being just the main list where all the data is collected, the 2nd being a list of found audit items, and the 3rd being left over items that need to be found at a later date.
Sub Update_Audit()
Dim j As Integer
Dim i As Integer
Dim k As Integer
Dim Aud_Tot As Integer
i = 2
Aud_Tot = Application.InputBox("How big is your audit", , , , , , , 1)
k = 2
Do While Cells(k, 24) <> ""
Tab_Data = Range(Cells(k, 24), Cells(k, 44)).Value
Worksheets(3).Activate
Range(Cells(k, 1), Cells(k, 22)).Value = Tab_Data
Worksheets(1).Activate
k = k + 1
Loop
Do While Cells(i, 1).Value <> "" And Not IsError(Cells(i, 2).Value)
Dataset = Range(Cells(i, 1), Cells(i, 22)).Value
Range(Cells(i, 1), Cells(i, 22)).Value = Dataset
Worksheets(2).Activate
Range(Cells(i, 1), Cells(i, 22)).Value = Dataset
Worksheets(1).Activate
For j = 2 To Aud_Tot
If CStr(Cells(j, 24).Value) = CStr(Cells(i, 2).Value) Then
Worksheets(3).Activate
Range(Cells(j, 1), (Cells(j, 22))).Delete Shift:=xlShiftUp
Worksheets(1).Activate
Exit For
End If
Next j
i = i + 1
Loop
End Sub
What I'm trying to do is have the program go through is find a certain value from within a column of cells and see if it matches with one cell after I special paste the value, and if there is a match delete the associated cell and its row of cells. What is happening is that the special pasting part of the program is working, but the associated cells are not being deleted. To clarify, I'm trying to delete a whole row from a certain column based on whether there's a match
Dim j As Integer
Dim i As Integer
i = 2
Dim Aud_Tot As Integer
Aud_Tot = Application.InputBox("How big is your audit", , , , , , , 1)
Do While True
If Cells(i, 1).Value <> "" And Not IsError(Cells(i, 2).Value) Then
Range(Cells(i, 1), Cells(i, 22)).Copy
Range(Cells(i, 1), Cells(i, 22)).PasteSpecial xlPasteValues
For j = 2 To Aud_Tot
If Cells(j, 24).Value = Cells(i, 2).Value Then
Range(Cells(j, 24), (Cells(j, 42))).ClearContents
End If
Next j
i = i + 1
Else
Exit Do
End If
Loop
It seems you want to delete the row but you are only using ClearContents. To delete you can change that line to Range(Cells(j, 24), (Cells(j, 42))).Delete Shift:=xlShiftUp, you can also use xlShiftToLeft.
Did you want to delete the entire row or just the range you have?
My worksheet have 6000 rows. This loop takes me more than 20minutes to finish. It is too long for me because I have many columns to run this loop. Can someone help me?
Dim i As Integer
For i = ActiveCell.Row To 5771
If Cells(i, ActiveCell.Column - 1).Value = 0 And Cells(i, ActiveCell.Column).Value = "" Then
Cells(i, ActiveCell.Column).Value = 0
ElseIf Cells(i, ActiveCell.Column - 1).Value = 1 Then
Range(Cells(i, ActiveCell.Column), Cells(i + 9, ActiveCell.Column)).Value = 1
ElseIf Cells(i, ActiveCell.Column - 1).Value = -1 Then
Range(Cells(i, ActiveCell.Column), Cells(i + 9, ActiveCell.Column)).Value = -1
End If
Next i
It is hard to tell exactly what you're trying to do. The loop structure you're using appears to be very inefficient: you're looping over rows in a range, and performing some evaluation/logic test on each cell.
If the adjacent (to the left) cell's value is 1 or -1, then you're filling the cell and the next 9 cells with that value. But then when you hit the Next in your loop, you will perform your test on those cells. So, either you should not be filling a value down 10 rows, or you should avoid testing those rows since presumably nothing needs to be done with them (otherwise you should not have filled them in in the first place!) So you can see why I am a little confused.
In any case, I assume that you do not need to test the 9 rows beneath when the Cells(i, ActiveCell.Column - 1).Value = 1 or Cells(i, ActiveCell.Column - 1).Value = -1.
I have not tested either of these so they may have some typos/etc.
The fastest method is to perform manipulations on yoru data in memory only. You can store the range's values in an array, and perform the operations on the array, and then "write" the values back to the worksheet in a single statement. Looping in memory is much faster than looping and writing on the worksheet.
Dim rng as Range
Dim arr as Variant
Dim val as Variant
Dim r as Long, i As Integer
Set rng = Range(Cells(ActiveCell.Row, ActiveCell.Column -1).Address, Cells(5771, ActiveCell.Column).Address)
'store the range values in a variant array:
' this will be of the structure arr(_row#_, _column#_)
arr = rng.Value
For r = 1 to UBound(arr, 1) 'Loop until last row in range/array
'arr(r,1) represents the first column of the range -- i.e., the column to left of ActiveCell
' so we can use a Case statement to check this value of either 0, 1, or -1.
Select Case arr(r, 1)
Case 0
'if the adjacent left cell = 0 AND this cell's value = ""
' then make this cell's value = 0.
If arr(r, 2) = "" Then arr(r, 2) = 0
Case 1, -1
For i = 0 to 10
'if the value is 1 or -1, puts the in this cell AND the next 9 cells
arr(r + i, 2) = arr(r, 1)
Next
'increment our iterator variable
r = r + 9
Case Else
'Do nothing...
End Select
Next
'put the transformed values in to the worksheet
rng.Value = arr
That is basically the same as this, which uses the worksheet object/cells in the loop. It more closely resembles your loop, but it will also be less efficient than the above.
'Alternatively, but this will be slower:
Dim rng as Range
Dim cl as Range
Dim i as Integer
Set rng = Range(Cells(ActiveCell.Row, ActiveCell.Column -1).Address, Cells(5771, ActiveCell.Column).Address)
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For each cl in rng.Cells
With cl
Select Case .Offset(0, -1).Value
Case 0
If .Value = "" Then .Value = 0
Case 1, -1
.Resize(10,1).Value = .Offset(0, -1).Value
Case Else
'Do nothing
End Select
End With
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
My code :
For i = 1 To iRowNumber
If Cells(i, x).Value > 1 Then
Cells(i, 2).Copy
Sheets(1).Select
Cells(1, 1).Value = Now
Cells(1, 2).Value = "Duplicate"
Cells(1, 4).Select
ActiveSheet.Paste
Cells(1, 3).Value = Mid(Cells(1, 4), 5, 4)
End If
Next i
x=x+1
Condition :
sheet(2) > 130916001, 130916001000009, 1 '~> check if 3rd column more than 1
expected result :
sheet(1) first row > time , "duplicate", 1600 , 130916001000009
sheet(2) 130916001, 130916001000009, 2 '~> change 1 become 2
result :
sheet(1) fine
sheet(2) 130916001, 130916001000009, not2 '~> error
If i extract this part of code, the counter works fine
Fyi i have 6 sheets, but dunno because of this or not?
Keeping #nutsch suggestions in mind, here is some code with qualified cells, so there's no confusion about which cells belong to which sheet. I'm not exactly sure what you're trying to accomplish, but should be easy enough to make appropriate changes.
Sub copyData()
Dim i As Long, x As Long, iRowNumber As Long
For i = 1 To iRowNumber
If Sheet2.Cells(i, 3) = 1 Then
With Sheet1
.Cells(i, 1).Value = Now() 'time
.Cells(i, 2).Value = "Duplicate"
.Cells(i, 3).Value = Mid(Sheet2.Cells(i, 2), 5, 4)
.Cells(i, 4).Value = Sheet2.Cells(i, 2).Value
End With
Sheet2.Cells(i, 3).Value = 2
End If
Next i
End Sub