I'm new to VBA and was writing a simple code to take all numbers in column A and add 99 to those numbers in column B. However, as soon as it passes 1000, an overflow occurs. What can I do to cut off the while loop so it doesn't overflow the remaining columns with 99? Thanks!
Sub Button1_Click()
Dim n As Integer
n = 0
While Cells(1 + n, 1) <= 1000
If Cells(1 + n, 2) = 0 Then
Stop
End If
Cells(1 + n, 2).Value = Cells(1 + n, 1) + 99
n = n + 1
Wend
End Sub
maybe you're after this:
Dim cell As Range
For Each cell In Range("A:A").SpecialCells(xlCellTypeConstants, xlNumbers) '<--| loop through column A cells with constant numeric content
If cell.Value > 1000 Then Exit For '<--| exit loop as soon as the current cell value exceeds 1000
cell.Offset(, 1).Value = cell.Value + 99
Next
Related
I have a dataset of 40,000 rows of data. My code is set so that it checks if the date in row n+1 is 1 day after the date in row n. If the dates in rows n and n+1 do not follow in normal chronological order, then it adds a row with blank data for that date.
My issues is that because I am adding rows along as I go, I have no idea what the ending range my for loop should have. I also tried just setting a really large range like "For n = 2 to 50000". But this gives me an overflow error.
Here is my code:
Sub MissingDates()
Dim n As Integer
Worksheets("sheet1").Activate
For n = 2 To 40000
If Cells(n, 2).Value <> Cells(n + 1, 2).Value - 1 Then
Cells(n + 1, 2).EntireRow.Insert Shift:=xlShiftDown
Cells(n + 1, 2) = Cells(n, 2) + 1
End If
Next
End Sub
Thank you in advance for any help.
A signed integer does not reach 40,000 and you should work from the bottom up.
Option Explicit
Sub MissingDates()
Dim n As Long, m As Long
With Worksheets("sheet1")
For n = .Cells(.Rows.Count, "B").End(xlUp).Row - 1 To 2 Step -1
For m = .Cells(n + 1, "B").Value2 - 1 To .Cells(n, "B").Value2 + 1 Step -1
.Cells(n + 1, 2).EntireRow.Insert Shift:=xlShiftDown
.Cells(n + 1, 2) = m
Next m
Next n
End With
End Sub
The overflow error comes because you declare n As Integer (i.e. 32,767) but you push it until 40,000. You can solve that by declaring n As Long instead.
As for your problem, you rather want a While loop instead of a For one. It should look something like this:
n = 2 '<- your starting value
Do While Cells(n+1,2).Value <> "" '<-- I guess you stop when there's no more value in your row
If Cells(n, 2).Value <> Cells(n + 1, 2).Value - 1 Then
Cells(n + 1, 2).EntireRow.Insert Shift:=xlShiftDown
Cells(n + 1, 2) = Cells(n, 2) + 1
End If
n = n + 1 '<-- increment n
Loop
I am trying to copy and paste a range that includes blank cells into a single column on another sheet. I would like the blanks to be ignored.
Here is the Frankenstein code I am using at the moment it is slow and a bit cluncky picture included to better describe
I would like to expand on it so that multiple ranges can paste into the same column ie find the last cell with a value and paste into the next cell.
i have been told it should look something like this
'for r = 1 to 4
' for c = 1 to 8
' does rc have val,
' then copy to new sheet
' increment copy var
' increment c
' increment r
Sheets(Array("next record date")).Select
Range("G11:AZZ110").Select
If TypeName(Selection) = "Range" Then
If Selection.Count > 1 Then
If Selection.Count <= Selection.Parent.Rows.Count Then
vaCells = Selection.Value
ReDim vOutput(1 To UBound(vaCells, 1) * UBound(vaCells, 2), 1 To 1)
For j = LBound(vaCells, 2) To UBound(vaCells, 2)
For i = LBound(vaCells, 1) To UBound(vaCells, 1)
If Len(vaCells(i, j)) > 0 Then
lRow = lRow + 1
Sheets("Data").Select
Range("E2").Select
vOutput(lRow, 1) = vaCells(i, j)
Else
End If
Next i
Next j
Selection.ClearContents
Selection.Cells(1).Resize(lRow).Value = vOutput
End If
End If
End If
Thanks,
Jerome
Special cells constants method and paste transpose
Public Sub TransposeRange()
ThisWorkbook.Worksheets("next record date").Range("G11:AZ11").SpecialCells(xlCellTypeConstants, 23).Copy
ThisWorkbook.Worksheets("Data").Range("E2").PasteSpecial Paste:=xlValues, Transpose:=True
End Sub
I'm stuck in an assignment for school, this is what i have to do:
This is the current code I have:
You need to loop in the array you've loaded and :
Sub Ratio()
Dim OperatingRatio() As Double
Dim j As Long
With Sheets("Summary")
OperatingRatio = .Cells("I80:M80").Value
For j = LBound(OperatingRatio, 2) To UBound(OperatingRatio, 2)
If OperatingRatio(1, j) > 100 Then
MsgBox .Cells(14, 9 + j)
.Cells(80, 9 + j).Interior.Color = vbRed
Else
End If
Next j
End With
End Sub
It is better if you loop through all cells individually, like this:
Dim i As Integer
'9 means column I and 13 is column M
For i = 9 To 13
' Getting the percent values
Debug.Print Worksheets("Summary").Cells(80, i).Value
Next
This way you can continue by yourself.
I'm currently trying to make a program that takes user input and stores the values in an array called FastenerNumbers. Based on these values the program then fills specific cells with a green color so that the user knows to enter values there. The thing is if a value in the array is 0 I would like to delete that column so that the worksheet is cleaner.
The issue I'm running into is that when a column is deleted during the for loop the cells shift left. Because of this some of the cells are essentially skipped over. To counteract this I've essentially had to brute force the program so that it loops several times to account for any skipped columns.
Here's the code:
'Make cells green for user to put inputs into
For i = 0 To UBound(FastenerNumbers)
If FastenerNumbers(i) <> 0 Then
With Range(Range("A14").Offset(0, 2 * i), Range("A14").Offset(FastenerNumbers(i) - 1, (2 * i) + 1))
.Borders.LineStyle = xlContinuous
.Interior.ColorIndex = 4
End With
End If
Next
'Define initial counter variable
j = 1
' Do Until j = 5
' For i = 0 To UBound(FastenerNumbers)
' If FastenerNumbers(i) = 0 Then
' Range(Range("A14").Offset(0, 2 * i), Range("A14").Offset(FastenerNumbers(i) - 1, (2 * i) + 1)).EntireColumn.Delete
' End If
' Next
' Loop
'
Do
For Each cell In Range("A14", Range("A14").Offset(, (UBound(FastenerNumbers) + 1) * 2))
If cell.Interior.ColorIndex <> 4 Then
cell.EntireColumn.Delete
End If
j = j + 1
If j >= (5 * (UBound(FastenerNumbers) + 1) * 2) Then
Exit Do
End If
Next
Loop
The pseudocode is another method I was going to use. I don't think either method is significantly better than the other. I would like the loops to be cleaner and more efficient though.
it as simple as having a separate variable (j) counting the number of valid FastenerNumbers() valueslike follows
'Make cells green for user to put inputs into
For i = 0 To UBound(FastenerNumbers)
If FastenerNumbers(i) <> 0 Then
With Range(Range("A14").Offset(0, 2 * j), Range("A14").Offset(FastenerNumbers(i) - 1, (2 * j) + 1)) ' use j as the column relevant variable
.Borders.LineStyle = xlContinuous
.Interior.ColorIndex = 4
End With
j = j + 1 'update column relevant variable
End If
Next
I haven't tested this so not entirely sure it works, but give this a shot. Essentially it keeps everything within the For loop, and if FastenerNumbers(i) = 0 then it deletes the column, reduces i by 1, then continues to the next (in that case the same number):
For i = 0 To UBound(FastenerNumbers)
If FastenerNumbers(i) <> 0 Then
With Range(Range("A14").Offset(0, 2 * i), Range("A14").Offset(FastenerNumbers(i) - 1, (2 * i) + 1))
.Borders.LineStyle = xlContinuous
.Interior.ColorIndex = 4
End With
Else
Range(Range("A14").Offset(0, 2 * i), Range("A14").Offset(FastenerNumbers(i) - 1, (2 * i) + 1)).EntireColumn.Delete
i = i - 1
End If
Next
I have a code that works, but I want to add some more functionality to it. It currently does what it is supposed to do, and has sped up some processes, but now I think it can be sped up even more. I am using the solution that I marked as answered here: Using VBA to get a threshold value
But
I have this code:
Sub OutputEnergyToAllSheets()
Dim w
For Each w In ThisWorkbook.Worksheets
If Not InStr(w.Name, "Total") > 0 And Not InStr(w.Name, "eV") Then
OutputEnergyToSheet w.Name
End If
Next w
End Sub
Sub OutputEnergyToSheet(TheSheet As String)
'y = Columns to check: 2-25
'x = Rows to check: 2-152
'z = check the next 4 cells
Dim x, y, z, check
'Clear the range where we store the #N/A or Energy Outputs
With Sheets(TheSheet)
.Range("B153:Y153") = vbNullString
For y = 2 To 25
For x = 2 To 152
If .Cells(x, y) > .Range("Z2") Then 'If value is greater than Z2
check = True 'Let's check the next 4
For z = 1 To 30 'If any of them fail
If .Cells(x + z, y) < .Range("Z2") Then
check = False 'The check fails
Exit For
End If
Next z
If check = True Then 'If the check doesn't fail
.Cells(153, y) = Int(.Cells(x, 1)) 'Set cell 153 to the energy level
Exit For
End If
End If
Next x 'If no energy level was set - #N/A
If .Cells(153, y) = vbNullString Then .Cells(153, y) = ""
Next y
End With
End Sub
But the line that says:
for z = 1 to 30
I am having to change from 0 to 100 in increments of 1. It outputs these values where it should on all worksheets and then I go to the sub and increase value and repeat. The values are output in each worksheet except a few in row 153. Is there a way to have 0 be in row 153, 1 be in 154, 2 in 155, etc up to 100? I understand if this is not possible, but it would me a TON of time, because I have to go through this process for many workbooks. If this can be done it will save me several monotonous hours of busy-work. Anyways, thanks for reading.
For this first code block, I tried to stay with the general structure of the code in your question. I could have for example swapped out the innermost two For loops for a single While loop. That would be more efficient but requires a significant logic change. I did make some changes though. I set everything to "N/A" at the beginning instead of the end and I added a condition to the last If statement. To implement your new functionality of checking for variable numbers of consecutive cells, I included another For loop with counter k around the For loop with counter z and made the end point of z dependent on k. We print out to row 152 + k.
Sub OutputEnergyToSheet(TheSheet As String)
'y = Columns to check: 2-25
'x = Rows to check: 2-152
'k = number of matches in a row to find
'z = check the next (k - 1) cells
Dim x, y, z, check, k
'Clear the range where we store the N/A or Energy Outputs
With Sheets(TheSheet)
.Range("B153:Y252") = "N/A"
For y = 2 To 25
For x = 2 To 151
If .Cells(x, y) > .Range("Z2") Then 'If value is greater than Z2
For k = 1 To 100
check = True 'Let's check the next k - 1
For z = 1 To k - 1 'If any of them fail
If .Cells(x + z, y) <= .Range("Z2") Then
check = False 'The check fails
Exit For
End If
Next z
If check = True And .Cells(152 + k, y) = "N/A" Then
.Cells(152 + k, y) = Int(.Cells(x, 1))
End If
Next k
End If
Next x
Next y
End With
End Sub
Before I did all this, I threw together my own method which is cleaner and runs much faster. The code below steps down the rows and maintains a running count of how many consecutive matches it has found. It eliminates a lot of checks because it only checks any given cell once. Down to 2 total loops! The code above was checking a cell many times over in the inner loops. The below code could probably be better by maintaining the values in an array (read/write in Excel is slow) and/or maintaining a counter of the maximum length I have already achieved for the current column. I stored most of my numbers as variables that can be easily and confidently modified.
Sub EfficientEnergy(ws As Worksheet)
Dim r As Integer, c As Integer, ctr As Integer
Dim compVal As Double
Dim maxRow As Integer, maxCol As Integer, maxConsecutive As Integer
maxRow = 151
maxCol = 25
maxConsecutive = 100
compVal = ws.Cells(2, 26).Value
ws.Range(ws.Cells(maxRow + 2, 2), ws.Cells(maxRow + maxConsecutive + 1, maxCol)).Value = "N/A"
For c = 2 To maxCol
ctr = 0
For r = 2 To maxRow
If ws.Cells(r, c).Value > compVal Then
ctr = ctr + 1
If ws.Cells(maxRow + 1 + ctr, c).Value = "N/A" Then
ws.Cells(maxRow + 1 + ctr, c).Value = ws.Cells(r - ctr + 1, 1).Value
End If
Else
ctr = 0
End If
Next r
Next c
End Sub
The code I am using to call these methods in my testing is (just comment out whichever one you aren't using):
Public Sub GetConsecutiveVals()
'OutputEnergyToSheet ("Sheet1")
Call EfficientEnergy(ActiveWorkbook.Worksheets("Sheet1"))
End Sub
Or to run on every worksheet in active workbook (untested):
Public Sub GetConsecutiveVals()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
'OutputEnergyToSheet (ws.Name)
Call EfficientEnergy(ws)
Next ws
End Sub
Place all your code in a module in a workbook. Open your workbook with data in Sheet1 (or change the code above to your sheet name). Hit Alt + F8 and then run the GetConsecutiveVals routine. If you don't see that method in the dialog window, make sure the workbook with the code and the workbook with your data are in the same Excel application window
#jack This is how i read this code. Check all cells from Column 2 - 25, Rows 2 - 152, if one of them is greater than Z2, Enter Zloop, Begin checking the next 30 rows, to see if any of those are smaller. if so do nothing, if one is, in cell 153,y = Column 1 same row, go to next column ..question: Why have Z only check 30? why not have it check the remaining 152 ...z= 1 to 152 - x ?
in any case i think this is what you want to do, create another variable say
DIM Result As Integer
Result = 153
''then below
If check = True Then 'If the check doesn't fail
''.Cells(153, y) = Int(.Cells(x, 1)) 'Set cell 153 to the energy level
.Cells(Result, y) = Int(.Cells(x, 1)) 'Set cell 153 to the energy level
Result = Result + 1
EXIT FOR
Why use three loops when one would do?
Sub OutputEnergyToAllSheets()
Dim w as worksheet
For Each w In ThisWorkbook.Worksheets
If Not InStr(1, w.Name, "Total") > 0 And Not InStr(1, w.Name, "eV") Then
OutputEnergyToSheet w.Name
End If
Next w
End Sub
Sub OutputEnergyToSheet(TheSheet As String)
Dim check as Boolean
Dim rng as Range
Dim c
Dim ELevel as integer
'Clear the range where we store the #N/A or Energy Outputs
With Sheets(TheSheet)
' set all cells in row 153 = 0
.Range("B153:Y153").value = 0
ELevel = .cells(2,26)
' Your range
set rng = .Range(.Cells(2,2), .cells(25, 153))
' Loop through all cells in range
For each c in rng.cells
' If value is greater then Z2 and respective column in row 153 = 0 and cell is not in 153 then change 153 = respective row column 1
If c.value > ELevel and .cells(153, c.column) = 0 and c.row <> 153 Then
.cells(153,c.column) = .cells(c.row, 1)
' If value is less then Z2 and cell is not in 153 then change 153 = 0
elseif c.value < ELevel and c.row <> 153 then
.cells(153, c.column) = 0
' Clean up - if cell is in row 153 and value = 0 then change to "N/A"
elseif c.row = 153 and c.value = 0 then
c.value = "N/A"
end if
Next c
End With
End Sub
Please let me know if I've misunderstood