I'm almost embarrassed to post this, but I am dumbfounded. 6 months ago, I wrote a VERY simple For/Next Loop to cycle through the cells of a column and, if certain criteria was met, perform an action. It has worked flawlessly for the past 6 months. Today, it quit working.
Sub Button1_Click()
Dim x As Integer
Dim DateCell As String
Dim LastRow As Variant
LastRow = Worksheets("Paste Here").Range("A65536").End(xlUp).Row
On Error Resume Next
For x = 2 To LastRow
DateCell = Worksheets("Paste Here").Range("A" & x)
If Right(DateCell, 4) = "2015" Then
Else
Worksheets("Paste Here").Range("A" & x).Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Worksheets("Paste Here").Range("A" & x).Value = Worksheets("Paste Here").Range("A" & x - 1).Value
End If
Next x
On Error GoTo 0
MsgBox ("Done! " & x & " rows analyzed.")
End Sub
When I step through to the "For" line, it sets the value of x to zero. When it gets to the "Next x" line, it increments it to 1, but then doesn't loop...instead it goes to "On Error" and finishes. I even tried setting x = 2 before the loop, but same thing....it will increment to 3 and then exit the loop.
What could have changed? I even went back to my original file and tried running it, same thing.
Matthew was on the right track. Because of this line:
LastRow = Worksheets("Paste Here").Range("A65536").End(xlUp).Row
If you have something in a cell in column A above A65536 and below cell A32768 then VBA will just set x to 0 and the loop will not execute.
Related
I want to have a macro which runs everytime I open the excel-file, then compares the date (I5) with the last entry in a list (column L), and if the date is older, copy some values (I5 and I11) and paste them in the next empty row of the list (columns L and M). I have written the code bellow but it does not work, I get runtime error 424 and every other syntax I found online and tried to adapt isn't working either. Can anyone help ?
Private Sub Workbook_Open()
If Worksheets("overdue").Range("I5").Value > Worksheets("overdue").Range("L2").End(xlDown).Value Then
Worksheets("overdue").Range("I5").Copy
Worksheets("overdue").Range("L1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues
Worksheets("overdue").Range("I11").Copy
Worksheets("overdue").Range("M1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues
End If
End Sub
Try the code below, in case you have only 1 row in column "L" (I guess header):
Private Sub Workbook_Open()
Dim LastRow As Long
With Worksheets("overdue")
LastRow = .Range("L1").End(xlDown).Row
If LastRow >= 2 Then
If .Range("I5").Value > .Range("L" & LastRow).Value Then
.Range("L" & LastRow + 1).Value = .Range("I5").Value
.Range("M" & LastRow + 1).Value = .Range("I11").Value
End If
End If
End With
End Sub
I have a loop that needs to stop when activecell value is "BBSE", but it passes the cell and continues the loop. someone can help me with that?
I cut rows from table in one workbbok and paste it to another. before the list in column F I have many blank cells, and because of that I am usind xldown.
Here is the relevant code:
'Illuminators Worksheet
OP_wb.Activate
Range("F2").End(xlDown).Select
Do Until ActiveCell.Value = "BBSE"
OP_wb.Activate
Worksheets("Optic Main").Activate
Range("F2").End(xlDown).Select
Selection.EntireRow.Cut
Demand_WB.Activate
Worksheets("Illuminators").Activate
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveSheet.Paste
Loop
Here is where I want to stop the loop in the red circle:
this is why I am using END.xlDown
If I understand what you are trying to achieve correctly, I believe the following will achieve it:
Dim startRow As Long
Dim endRow As Long
With OP_wb.Worksheets("Optic Main")
startRow = .Range("F2").End(xlDown).Row
endRow = .Columns("F").Find(What:="BBSE", LookIn:=xlValues, LookAt:=xlWhole).Row
.Rows(startRow & ":" & endRow).Cut
End With
With Demand_WB.Worksheets("Illuminators")
.Range("A" & .Rows.Count).End(xlUp).Offset(1).Insert Shift:=xlDown
End With
May be try like this...
'Mentioning Starting Row Here
x = 2
Do
'x refers to Row and F refer to column name
With Cells(x, "F")
'Exiting Do Loop once it finds the matching value using If statement
If .Value = "BBSE" Then Exit Do
OP_wb.Activate
Worksheets("Optic Main").Activate
.EntireRow.Cut
Demand_WB.Activate
Worksheets("Illuminators").Activate
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveSheet.Paste
End With
'Incrementing row number here to move on to next row
x = x + 1
Loop
I have macro which copy cells to below's cells.
Sub CopyRows2()
Dim LastRow As Long
With Worksheets("Ready to upload") ' <-- here should be the Sheet's name
LastRow = .Cells(.Rows.Count, "AD").End(xlUp).Row ' last row in column C
For i = 2 To LastRow
If Range("AD" & i) > "" And Range("AD" & i + 1) = "" Then
Range("AD" & i).Copy
Range("AD" & i + 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Else
End If
Next
End With
ActiveWindow.ScrollRow = 1 'scrolling the screen to the top
End Sub
It works fine, until it will found #N/A, then it will give me an error msg: Run-time error '13' - type mismatch. In that case, I would like to skip it and then continue in copy rows.
[
Could you advise me, how to do that, please?
Many thanks!
Option 1
The easiest way is to embed On Error Resume Next in your code. Then it will work.
Option 2
If you want to be one step more professional, then you can use something like this:
Sub CopyRows2()
Dim LastRow As Long
On Error Resume Next
'your code
If Err.Number = 13 Then Err.Clear
On Error GoTo 0
End Sub
It will disregard error 13, but it will tell you if there are other errors, which is quite useful.
Option 3 Check for error like this:
If Not IsError(Range("AD" & i)) And Not IsError(Range("AD" & i + 1)) Then
'embed the code here
End If
Doing a reverse for loop in Excel VBA, looking for the last populated cell in a certain column. Once found, it should exit the loop, but Exit For is not working, and continues looping all the way back. Any ideas?
rewind:
' so we 're still "under", rollback to the right line
While Not Range("I" & a).Value = getsum
a = a - 1
On Error GoTo TryCatch
If Not Range("E" & a).Value = "" Then
Rows(a).Select
currfield = Range("E" & a).Value
runningstrsum = runningstrsum - currentstrsum 'we're switching streets
' and since we just lost currentstrsum, we have to reset it to the last one, yay
For c = a - 1 To 2 Step -1
If Not Range("E" & c).Value = "" Then 'there it is
currentstrsum = Range("E" & c).Value
Exit For
End If
Next c
End If
Wend
If overunder < 0 Then 'go back to overunder<
GoTo goodjobunder
ElseIf overunder = 0 Then
GoTo goodjobeven
End If
You're only exiting the inner loop, the code will resume outside of this loop - which is still inside the While loop and therefore re-enter the For loop.
If you want to find the last populated cell in a column just use something like:
Dim lastCell As Excel.Range
Set lastCell = Range("E" & Rows.Count).End(xlUp)
No need to loop.
Might also be a good time to look at Debugging VBA Code
The first code is there to see if the number 20 is already in the spaces B28 till B47. If that is the case, I want it to move on to the next step. If the number 20 is not there, then i would like it to add the number to line B47 and then end after completing that. I'm haing problems trying to get it to stop after it added the number 20. Instead of ending, it continues down the column and adds een more 20s due to it not finidng any. What I have been trying to create is a loop which checks all the cells first, and if it does not find 20 it adds it once, instead of adding it 20 times.
The second code I hae after this is there to try to delete all empty rows in B28 till B47. However, it does not do that and skips this loop entirely moving to Blargh3 instead. I have tried creating loops for this, but Excel has always been giving me an error with it. I have tried researching as to how I could fix it after i have tried myself. I was not able to find anything which helped me.
As I am quite new to VBA, help would be greatly appreciated.
For Each Cell In Worksheets("Sheet1").Range("B28:B48")
If Cell.Value > 19 Then
GoTo Blargh2
Else:
Range("B" & 47, "BM" & 47).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B" & 47) = 20
Dim a As Long
For a = 3 To 65
Cells(47, a) = 3
Next
End If
Next
Blargh2:
For Each Cell In Worksheets("Sheet1").Range("B28:B47")
If Cell.Value = 0 Then
Row.Delete X1DeleteShiftUp
Else:
GoTo Blargh3
End If
Next
Blargh3:
Dim i As Long
For i = 47 To 29 Step -1
If Range("B" & i) - Range("B" & i).Offset(-1, 0) > 1 Then
Range("B" & i, "BM" & i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B" & i) = Range("B" & i).Offset(1, 0) - 1
Dim c As Long
For c = 3 To 65
Cells(i, c) = 3
Next
i = i + 1
End If
Next
Turn on your Immediate Window -> ctrl+g or in the menu bar click View => Immediate Window
This would be the first part based on your logic
Sub FirstPart()
Dim is20There As Range
With Range("B28:B47")
Set is20There = .Find(What:="20", LookIn:=xlValues, lookat:=xlPart)
End With
If is20There Is Nothing Then
Debug.Print "20 is not there, executing your code now"
Range("B" & 47, "BM" & 47).Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B" & 47) = 20
Dim a As Long
For a = 3 To 65
Cells(47, a) = 3
Next
Else
Debug.Print "exiting because 20 is there"
End If
End Sub
What happens here in the first loop is
using the .Find function in range B28:B47 to find the value of 20. If the value is there then the Else part of the loop will execute which simply does nothing but prints a message to the Immediate Window that 20 has been found.
this is when the 20 is not there
If 20 is not found (If is20There is Nothing evaluates to True) then you can execute your code which I guess adds a row at B47 (shifting the last row down ) and fills the cells with number 3 all the way down to 65th column except the B column which you seem to assign number 20 to.
So if 20 is not there the code literally does nothing.
this is when 20 is there (nothing happens)
The second part loops through B28:B47 backwards ( starting form the end to beginning ) and deletes the entire rows if any of them are empty ( column B only )
this is before
then run the code
Sub SecondPart()
Dim i As Long
Dim cell As Range
For i = 47 To 28 Step -1
Set cell = Range("B" & i)
If IsEmpty(cell) Then
Rows(cell.Row & ":" & cell.Row).Delete shift:=xlUp
End If
Next i
End Sub
and this is after