How to create a loop inside a loop vba - 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

Related

How to increment a Range object with a Loop

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)

excel macro to add value from cell to a table

I am looking to use a macro to add the value of a certain cell in a worksheet to a table in another worksheet each time each time a button is pressed. For example, the first time the button is pressed I want the value of cell A1 in worksheet2 to be equal to cell C3 in worksheet1, next time B1 in worksheet2 is equal to C3 in worksheet1 , and so on. The macro should only add a value to the table if the cell thst it's being added to is empty.
This is what I have so far:
Sub Button32_ClickandUpdate
myVariable = Worksheets("Worksheet1").Range("C3")
For i = 1 To 6
If IsEmpty(Cells(1, i)) Then
Worksheets("Worksheet2").Range(Cells(1,i)) = myVariable
Exit Sub
End If
Next i
End Sub
Any help would be greatly appreciated.
Try the code below, to update one cell at a time (when cell is empty)
Sub Button32_ClickandUpdate()
For i = 1 To 6
If IsEmpty(Sheets("Worksheet2").Cells(1, i).Value) Then
Sheets("Worksheet2").Cells(1, i).Value = Sheets("Worksheet1").Range("C3").Value
Exit Sub
End If
Next i
End Sub
Comment: you can use this also without the .Value
Try this:
Sub Button32_ClickandUpdate
myVariable = Worksheets("Worksheet1").Range("C3")
For i = 1 To 6
If IsEmpty(Worksheets("Worksheet2").Cells(1, i)) Then
Worksheets("Worksheet2").Cells(1, i) = myVariable
'Exit Sub (remove or comment this line to update all cells at the sime time)
End If
Next i
End Sub
Edit
According to new description given:
Sub Button32_ClickandUpdate
myVariable = Worksheets("Worksheet1").Range("C3")
i = 1
While i < 7
If IsEmpty(Worksheets("Worksheet2").Cells(1, i)) Then
Worksheets("Worksheet2").Cells(1, i) = myVariable
End If
i = i + 1
Wend
End Sub

Excel VBA Loop to Sum two consecutive cells

I am new to using VBA within Excel and have come stuck while trying to create a loop to sum two consecutive numbers and output that to a merged cell to the side. The data looks as below:
Number - Sum
1 - 8
7 -
1 - 2
1 -
So I would like to loop throug the numbers in column 1 and add up the first 2 numbers (1 and 7 which would be cells A1 and A2) and return that value to the merged cell to the right of it which would be B1.
Below is what I have so far which does calculate correctly Cells A1 and A2 and put the value of 8 into Cell B1 but then just doesnt work at all. I have got a loop to work with calculating 2 values in seperate rows before but can't ge tmy head around how i can do that in this situation.
Sub Loop_Sum()
Set rng = Range("A1:A6")
For Each cell In rng
Cells(cell, 2) = Cells(cell, 1) + Cells(2, cell)
Next cell
End Sub
Appreciate any help / pointers.
Thanks.
You need to change to an incremented For .. Next and advance the increment step by 2.
Sub Loop_Sum()
dim i as long, rng as range
Set rng = Range("A1:A6")
For i= 1 to rng.cells.count step 2
rng(i).offset(0, 1) = rng(i) + rng(i + 1)
Next cell
End Sub
You want to use the Offset function:
Sub Loop_Sum()
Set rng = Range("A1:A6")
For Each cell In rng
If cell.Row Mod 2 = 0 Then 'Change 0 to 1 if it ends up on the worng row.
cell.Offset(, 2) = cell + cell.Offset(1)
End If
Next cell
End Sub
If you want a formula then put this in C2:
=If(mod(row(),2)=0,A2+A3,"")
And copy down.

excel vba compare one range with another

I'm quite massively out of my depth here having never used vba before (My main role is primarily sql based), i'd like to sit down and spend a few days actually learing how all this works but i don't have days right now, hence throwing myself on your mercy!
Sub updateduration()
If Worksheets("Sheet1").Range("I4").Value = "Y" Then
Worksheets("Sheet1").Range("H4").Interior.ColorIndex = 43
Else
If Worksheets("Sheet1").Range("J4").Value = 1 Then
Worksheets("Sheet1").Range("H4").Interior.ColorIndex = 3
Else
If Worksheets("Sheet1").Range("J4").Value = 0 Then
Worksheets("Sheet1").Range("H4").Interior.ColorIndex = 45
End If
End If
End If
End Sub
As ugly as that probably is it works, Im now trying to adapt it so it adjusts all the cells in range H4:H34 one by one checking each if statement against the equivelant cell (i.e. range I4:I34 and range J4:34)
I've been looking at 'for each' to form an initial loop but am struggling to figure out how to specify which cells in the other ranges to look at in each iteration of the loop.
Any help or advice appreciated
L
Welcome to SE, L! You're off to a good start, and you're right that a FOR..NEXT loop is what you're looking for. The trick is to edit your Range with a variable, like this:
Sub updateduration()
Dim startRow As Integer, endRow As Integer
startRow = 4 'first row to compare/update
endRow = 34 'last row to compare/update
For myRow = startRow To endRow
If Worksheets("Sheet1").Range("I" & myRow).Value = "Y" Then
Worksheets("Sheet1").Range("H" & myRow).Interior.ColorIndex = 43
Else
If Worksheets("Sheet1").Range("J" & myRow).Value = 1 Then
Worksheets("Sheet1").Range("H" & myRow).Interior.ColorIndex = 3
Else
If Worksheets("Sheet1").Range("J" & myRow).Value = 0 Then
Worksheets("Sheet1").Range("H" & myRow).Interior.ColorIndex = 45
End If
End If
End If
Next myRow
End Sub

Excel VBA: add a blank cell below every output

I have a little problem with my VBA code. I use the code below to display every date in a date range. So if the date range is 3 Dec - 5 Dec, it will display 3 Dec in cell E10, 4 Dec in cell E11 and 5 Dec in cell E12. This works fine, however I need to add 4 blank cells below every date (so 3 Dec will be in cell E10, but the 4th of December will be shown in cell E15 etc).
Private Sub cmdOK_Click()
Dim RowCount As Long
Dim ctl As Control
' Check user input
If Me.SdPicker.Value = "" Then
MsgBox "Please enter an start date.", vbExclamation, "Start data error"
Me.SdPicker.SetFocus
Exit Sub
End If
If Me.EdPicker.Value = "" Then
MsgBox "Please enter the end date.", vbExclamation, "End date error"
Me.EdPicker.SetFocus
Exit Sub
End If
' Write data to worksheet
With Worksheets("Projection_Daily").Range("X1")
.Value = Me.SdPicker.Value
End With
With Worksheets("Projection_Daily").Range("Y1")
.Value = Me.EdPicker.Value
End With
' Close the form to open Output sheet and implement date range
Worksheets("Projection_Daily").Activate
Worksheets("Projection_Daily").Columns(5).ClearContents
Dim StartDate As Date
Dim EndDate As Date
Dim NoDays As Integer
StartDate = Worksheets("Projection_Daily").Range("X1").Value
EndDate = Worksheets("Projection_Daily").Range("Y1").Value
NoDays = EndDate - StartDate + 4
Worksheets("Projection_Daily").Range("E10").Value = StartDate
Worksheets("Projection_Daily").Range("E10").Resize(NoDays).DataSeries Rowcol:=xlColumns, Type:=xlChronological, Date:=xlDay, Step:=1, Stop:=EndDate, Trend:=False
Unload Me
End Sub
This is the code I currently use, I have tried to insert .Offset(4,0) to the code but with no luck. I hope you can help me with this.
Thanks!
Try using a Loop condition like this:
i = 1 'To loop through the no of days
j = 10 'To start from row no 10
For i = 1 To NoDays 'Nodays = Enddate-Startdate
Sheet1.Cells(j, 5).value = StartDate
StartDate = StartDate + 1
j = j + 5 'To add a gap of 4 blank rows
Next i