How to increment a Range object with a Loop - vba

In this code I'm trying to increment two Range object's using .OffSet(1, 0).Activate.
Function Foundry_check_func(target_cell As Range, result_cell As Range)
For x = 1 To 20
If result_cell <= 5 Then
target_cell = "Value 1"
ElseIf result_cell >= 10 Then
target_cell = "Value 2"
Else: target_cell = "Value 3"
End If
With target_cell
.Interior.Color = RGB(0, 255, 0)
End With
target_cell.Offset(3, 0).Activate
result_cell.Offset(4, 0).Activate
Debug.Print ("Value: " & result_cell & " Loop: " & x)
Next x
' Don't forget to format target cell at end of loop
End Function
Sub Foundry_check()
Main = Foundry_check_func(Range("J22"), Range("K22"))
End Sub
However, I can see using Debug.Print that after each loop, the cell being read does not change. Here's the output:
Value: 1 Loop: 1
Value: 1 Loop: 2
Value: 1 Loop: 3
Value: 1 Loop: 4
Value: 1 Loop: 5
etc.
I've made a similar macro work using ActiveCell instead of a Range. But in this program I need to OffSet two sets of cells. One to read data (result_cell) and another to write a value based on that data (target_cell). I'm not sure how I could use ActiveCell to offset two different cells in the same loop.
Any help would be appreciated.

Here's the issue that I see...
Your value isn't changing because you're target_cell isn't changing... you should add
target_cell.address
to your debug script and you will see it's not changing...
To change the target cell you need to set the target_cell you can't just activate another... so you would do this:
set target_cell = target_cell.Offset(3, 0)
set result_cell = result_cell.Offset(4, 0)

Related

How to create a loop inside a loop vba

I am trying to create this loop inside the loop so as to print inside the cells in the below range -> Week i where i is from 1 to 6 and it raises by one each time we move to a cell down...
So, in this case, for D2 I want Week 1, For D3 Week 2 etc.. Any ideas? I appreciate your time!
Sub INPUT()
Sheets("1").Select
For Each cell In range("D2:D7")
For i = 1 To 6
cell.Value = "Week +" & i
i = i + 1
Next i
Next cell
End Sub
You only need the one loop:
Sub INPT()
With Sheets("1")
i = 1
For Each cell In .Range("D2:D7")
cell.Value = "Week +" & i
i = i + 1
Next cell
End With
End Sub

Using something similar to OFFSET for return type Range

I want to create a Do While ... Loop that will step through each cell
in a column and check to see if the value in each cell is a number. It should also keep a count of how many numbers there are before the first non-number entry
But, I don't know what technique to use to step down cell-by-cell... this is what I had first tried (it is simplified and assumes there are numbers in column A starting from row 1 down to an arbitrary row):
Counter = 0
Iteration = Worksheets("Sheet1").Range("A1")
Do While IsNumeric(Iteration) = True And IsEmpty(Iteration) = False
Counter = Counter + 1
Iteration = Iteration.Offset(1,0)
Loop
However, this doesn't work because Offset(1,0) returns the value within the referenced cell. So, I need something similar to Offset but with a return value of type Range. Thank you!
You need to Declare Iteration as Range and Set it.
And the count is not needed:
Dim Iteration as Range
Set Iteration = Worksheets("Sheet1").Range("A1")
Do While IsNumeric(Iteration.Value) And Iteration.Value <> ""
Set Iteration = Iteration.Offset(1,0)
Loop
Sub checkNumber()
For x = 2 To Range("a65536").End(xlUp).Row
If IsNumeric(Range("a" & x).Value) Then
Range("b" & x).Value = "this is a number"
Else
Range("b" & x).Value = "this is not a number"
End If
Next x
End Sub

In VBA, I want to make an If statement for when more than one cell in a range contains a value

So I have the following VBA loop set up, but want to add a line that says "If there are two cells within this range that have a value, do this. If there are three cells within a range that have a value, do that." What I have so far is:
Sub Test1()
Dim Rng As Range
Dim i As Long
i = 3
Application.ScreenUpdating = True
While i <= 133
Set Rng = Range("C" & i)
If Rng.Offset(, 2).Resize(, 7) <> "" Then
Rng.Offset(, 1).FormulaR1C1 = "Blank"
i = i + 1
Else: Stop
End If
Wend
End Sub
So I have the VBA script print the word "Blank" into the appropriate cell if this range is empty. But how can I add more lines to say "If one cell in this range contains a value," or "if two cells in this range contain a value"
Here is how you can check if there are more than one non-empty cell in the given range:
If Application.WorksheetFunction.CountA(Rng.Offset(, 2).Resize(, 7)) > 1 Then
Few additional tips to your code:
If you know exactly the initial and final value of i you should use For ... Next loop instead of While ... Wend. So you could replace this code:
i = 3
'(...)
While i <= 133
'(...)
i = i + 1
Wend
with this:
For i = 3 To 133
'(...)
Next i
I think this line of code will cause Type mismatch error:
If Rng.Offset(, 2).Resize(, 7) <> "" Then
because you are trying to compare an object of Range type with a primitive value (empty string). To avoid this issue you can use the similar code as above:
If Application.WorksheetFunction.CountA(Rng.Offset(, 2).Resize(, 7)) = 0 Then
you might like to add code along these lines
Select case Application.WorksheetFunction.CountA(Rng.Offset(, 2).Resize(, 7))
case 0
Rng.Offset(, 1).value = "Blank"
case 1
Rng.Offset(, 1).value = "Only One"
case >2
Rng.Offset(, 1).value = "More than 1"
end select

How do I make value static in last row value?

Here is the code below:
Public n as Long ' <--above sub procedure
With Sheets("Sheet1").Range("A6").Offset(n, 0)
If n = 0 Then
.Value = 1
Else
.Value = .Parent.Range(.Address).Offset(-1, 0) + 1
End If
n = n + 1
End With
(See pic below) If I delete 4 then click command button again it just reset back to 1. I want to make it static so even I deleted the last value of row it still continue increment from the last value.
Store number
1
2
3
4
Try this:
Sub Test()
Dim trow As Long
With Sheets("Sheet1") '~~> change to suit
trow = .Range("A:A").Find(vbNullString, [A5]).Row
With .Range("A" & trow)
If trow = 6 Then .Value = 1 _
Else .Value = .Offset(-1, 0).Value + 1
End With
End With
End Sub
Above code finds the first blank cells. If it is A6 it assigns a value of 1.
Otherwise it assigns previous cell value plus 1. Is this what you're trying?
Edit1: Explanation
trow = .Range("A:A").Find(vbNullString, [A5]).Row
This finds the first empty row in Column A starting A5.
[A5] is used to return Range("A5") object. So it can also be written as:
trow = .Range("A:A").Find(vbNullString, .Range("A5")).Row
We used a VBA vbNullString constant as What argument in Range Object Find Method.
Find Method returns a Range Object so above can be written also like this:
Sub Test()
Dim r As Range
With Sheets("Sheet1") '~~> change to suit
Set r = .Range("A:A").Find(vbNullString, [A5])
With r
If .Row = 6 Then .Value = 1 _
Else .Value = .Offset(-1, 0).Value + 1
End With
End With
End Sub
What your asking for, a button with memory doesn't sound neatly solvable using just VBA.
You could potentially have a list on a hidden sheet that gets a value added to it each time the commandButton is pressed and it writes the max of the list values back to the target cell?
Alternatively you could investigate using a scrollbar from the form control section of the developer tab with a link to your target cell. I often use this technique for interactive sheets.
Named Range Method
Public sub btnPress
dim val as long
val = Range("PreviousCellValue")
set Range("PreviousCellValue") = val+1
Sheets("Sheet1").Range("A6").Offset(n, 0).value = Range("PreviousCellValue")
End sub btnPress

Continue For loop

I have the following code
For x = LBound(arr) To UBound(arr)
sname = arr(x)
If instr(sname, "Configuration item") Then
'**(here i want to go to next x in loop and not complete the code below)**
'// other code to copy past and do various stuff
Next x
So I thought I could simply have the statement Then Next x, but this gives a "no for statement declared" error.
So what can I put after the If instr(sname, "Configuration item") Then to make it proceed to the next value for x?
You can use a GoTo:
Do
'... do stuff your loop will be doing
' skip to the end of the loop if necessary:
If <condition-to-go-to-next-iteration> Then GoTo ContinueLoop
'... do other stuff if the condition is not met
ContinueLoop:
Loop
You're thinking of a continue statement like Java's or Python's, but VBA has no such native statement, and you can't use VBA's Next like that.
You could achieve something like what you're trying to do using a GoTo statement instead, but really, GoTo should be reserved for cases where the alternatives are contrived and impractical.
In your case with a single "continue" condition, there's a really simple, clean, and readable alternative:
If Not InStr(sname, "Configuration item") Then
'// other code to copy paste and do various stuff
End If
For i=1 To 10
Do
'Do everything in here and
If I_Dont_Want_Finish_This_Loop Then
Exit Do
End If
'Of course, if I do want to finish it,
'I put more stuff here, and then...
Loop While False 'quit after one loop
Next i
A lot of years after... I like this one:
For x = LBound(arr) To UBound(arr): Do
sname = arr(x)
If instr(sname, "Configuration item") Then Exit Do
'// other code to copy past and do various stuff
Loop While False: Next x
A few years late, but here is another alternative.
For x = LBound(arr) To UBound(arr)
sname = arr(x)
If InStr(sname, "Configuration item") Then
'Do nothing here, which automatically go to the next iteration
Else
'Code to perform the required action
End If
Next x
And many years later :D I used a "select" statement for a simple example:
For Each zThisRow In zRowRange
zRowNum = zThisRow.Row
Select Case zRowNum
Case 1 '- Skip header row and any other rows to skip -----
'- no need to put anything here -----
Case Else '- Rows to process -----
'- Process for stuff to do something here -----
End Select
Next zThisRow
You can make this as complex as you wish by turning each "if" result into a value (maybe a bit of over complex code would help explain :D ):
zSkip = 0
If 'condition1 = skip' Then zSkip = zSkip + 1
If 'condition2 = skip' Then zSkip = zSkip + 1
If 'condition3 = skip' Then zSkip = zSkip + 1
Select Case zRowNum
Case 0 '- Stuff to do -----
Case Else '- Stuff to skip -----
End Select
It's just a suggestion; have a great Christmas peeps!
This can also be solved using a boolean.
For Each rngCol In rngAll.Columns
doCol = False '<==== Resets to False at top of each column
For Each cell In Selection
If cell.row = 1 Then
If thisColumnShouldBeProcessed Then doCol = True
End If
If doCol Then
'Do what you want to do to each cell in this column
End If
Next cell
Next rngCol
For example, here is the full example that:
(1) Identifies range of used cells on worksheet
(2) Loops through each column
(3) IF column title is an accepted title, Loops through all cells in the column
Sub HowToSkipForLoopIfConditionNotMet()
Dim rngCol, rngAll, cell As Range, cnt As Long, doCol, cellValType As Boolean
Set rngAll = Range("A1").CurrentRegion
'MsgBox R.Address(0, 0), , "All data"
cnt = 0
For Each rngCol In rngAll.Columns
rngCol.Select
doCol = False
For Each cell In Selection
If cell.row = 1 Then
If cell.Value = "AnAllowedColumnTitle" Then doCol = True
End If
If doCol Then '<============== THIS LINE ==========
cnt = cnt + 1
Debug.Print ("[" & cell.Value & "]" & " / " & cell.Address & " / " & cell.Column & " / " & cell.row)
If cnt > 5 Then End '<=== NOT NEEDED. Just prevents too much demo output.
End If
Next cell
Next rngCol
End Sub
Note: If you didn't immediately catch it, the line If docol Then is your inverted CONTINUE. That is, if doCol remains False, the script CONTINUES to the next cell and doesn't do anything.
Certainly not as fast/efficient as a proper continue or next for statement, but the end result is as close as I've been able to get.
you can do that by simple way, simply change the variable value that used in for loop to the end value as shown in example
Sub TEST_ONLY()
For i = 1 To 10
ActiveSheet.Cells(i, 1).Value = i
If i = 5 Then
i = 10
End If
Next i
End Sub
I sometimes do a double do loop:
Do
Do
If I_Don't_Want_to_Finish_This_Loop Then Exit Do
Exit Do
Loop
Loop Until Done
This avoids having "goto spaghetti"