I've beeing searching around for quite a while and trying.
What I want to do, is basically an auto-fill that only increments when it finds a value of "02:00" on the column F
1 00:15
1 00:45
1 01:00
1 01:15
1 01:30
1 01:45
1 02:00 -
2 00:15
2 00:45
2 01:00
2 01:15
2 01:30
2 01:45
2 02:00 -
3 00:15
3 00:45
3 01:00
3 01:15
3 01:30
3 01:45
3 02:00
The code I've does it almost right but always end up filling the column with the last value of the iterator.
'Days :D
i = 0
For Each c In Range("F57:F77")
For Each x In Range("E57:F77")
x.Value = i
If c.Value = "02:00 " Then
i = i + 1
If i >= 4 Then
'Exits when overlap
Exit Sub
End If
Debug.Print i
End If
Next
Next
Have you considered using a native worksheet function like COUNTIF for a bulk operation?
With Worksheets("Sheet7")
With .Range("F57", .Cells(Rows.Count, "F").End(xlUp))
.Offset(0, -1).Formula = "=COUNTIF(F$57:F57, ""02:00"")+1"
.Cells = .Value
End With
End With
How about:
Sub qwerty()
Dim x As Long, r As Range
x = 1
For Each r In Range("F57:F77")
r.Offset(0, -1).Value = x
If r.Text = "02:00" Then x = x + 1
Next r
End Sub
Related
I'm trying to learn vba excel. With below code I want that the sheet 1 (A1:C8) will be filled with numbers [1-24].
I'm getting the following errors: Else without If and Next without For
Public Sub InsertNummer()
Worksheets("sheet1").Activate
Dim Count, RO, CL As Integer
For CL = 1 To 3 Step 1
For RO = 1 To 8 Step 1
If CL = 1 Then
For Count = 1 To 8 Step 1
Cells(RO, CL).Value = Count
ElseIf CL = 2 Then
For Count = 9 To 16 Step 1
Cells(RO, CL).Value = Count
Else
For Count = 17 To 24 Step 1
Cells(RO, CL).Value = Count
End If
Next Count
Next RO
Next CL
End Sub
You may want to spend some more time looking through how For Loops work correctly.
They really are quite basic and easy to learn but I've got you a code here which is much simpler to achieve the same results:
Sub InsertNumber()
Dim CL As Long, RO As Long, Count As Long
Count = 1
For CL = 1 To 3 'Columns 1 to 3
For RO = 1 To 8 'Rows 1 to 8
Cells(RO, CL) = Count
Count = Count + 1
Next RO
Next CL
End Sub
With Loops or If statements, they need to be ended in the order they were started.
So for an if statement in a for loop within an if statement you do:
If ...
For ...
If ...
Elseif ...
Else ...
End If
Next
End If
The structure needs to be kept like that.
The following code I have Will paste a value code of "01" to a cell and then skip 4 rows continuously, until reaching the end of count within the for loop. I want to run a similar loop for "02", but rather than "Step" (skip) 4 rows, I would like it to insert the value in 6 consecutive rows within the same column and then skip 3 rows continuously until reaching the end of count. I am 2 weeks new to vba, so I hope I am explaining this correctly.
Dim i As Long
If Sheet3.Range("C22").Value = "01" Then
For i = 3 To 202 Step 4
ActiveWorkbook.Sheets("CrewEntries").Cells(i, 6).Value = _
ActiveWorkbook.Sheets("MonData").Cells(22, 5).Value
Next i
ElseIf Sheet3.Range("C22").Value = "02" Then
For i = 3 To 152
ActiveWorkbook.Sheets("CrewEntries").Cells(i, 6).Value = _
ActiveWorkbook.Sheets("MonData").Cells(22, 5).Value
Next i
End If
Maybe like this:
Dim i As Long, v
v = ActiveWorkbook.Sheets("MonData").Cells(22, 5).Value
If Sheet3.Range("C22").Value = "01" Then
For i = 3 To 202 Step 4
ActiveWorkbook.Sheets("CrewEntries").Cells(i, 6).Value = v
Next i
ElseIf Sheet3.Range("C22").Value = "02" Then
For i = 3 To 152 Step 9 '6 filled + 3 empty = 9
ActiveWorkbook.Sheets("CrewEntries").Cells(i, 6).Value = v
Next i
End If
For such a kind of question, I would advise a while-loop, as in this piece of pseudo-code:
dim condition as boolean
dim loop_step, interesting_value as integer
condition = true
loop_step = 1 'just in order to be sure that it never is 0, this might create an infinite loop
interesting_value = 0 ' or some other initialisation value
while condition do
if <some_first_condition>
then
do_first_thing(interesting_value, ...)
loop_step = 3
else
do_second_thing(interesting_value, ...)
loop_step = 6
end if
interesting_value = interesting_value + loop_step
if <some_other_condition> then condition = false
Wend
Sub EarningCode()
Dim CpID As String
Dim i As Long
Dim p As Long
CpID = ActiveWorkbook.Sheets("MonData").Cells(22, 3).Value
For i = 3 To 452
If p = 9 Then
p = 1
Else
p = p + 1
End If
If p < 7 Then
ThisWorkbook.Worksheets("CrewEntries").Cells(i, 4).Value = "02"
End If
Next i
End Sub
Hi I am trying to compare two sets of data by having indicators if they increased, decreased, or stayed the same. I was able to get it working on one column. My problem is I can't loop it on multiple columns.
Basically:
If A1 = C1 then D1.Value = 0
If A1 > C1 then D1.Value = 1
If A1 < C1 then D1.Value = 2
I've tried to do the "do while" to add increments on the columns but it did not work.
Sub ChangeIndicator2()
Dim i As Long
Dim a As Long
Dim b As Long
Dim x As Long
Dim y As Long
Dim ProgramCount As Long
i = 2
a = 8
b = 2
x = 0
y = 8
ProgramCount = 12
Do While y <= ProgramCount
For Each c In Worksheets("Sheet1").Range("A2:A20").Offset(x, y)
If Worksheets("Sheet1").Cells(i, a).Value = Worksheets("Sheet1").Cells(i, b).Value Then
c.Value = 0
ElseIf Worksheets("Sheet1").Cells(i, a).Value < Worksheets("Sheet1").Cells(i, b).Value Then
c.Value = 1
ElseIf Worksheets("Sheet1").Cells(i, a).Value > Worksheets("Sheet1").Cells(i, b).Value Then
c.Value = 2
End If
i = i + 1
Next c
a = a + 2
b = b + 2
y = y + 2
Loop
End Sub
Only the first column works, the second column only shows 0 values.
So basically, what you want to do is compare 2 columns which are 2 columns apart and repeat that on another pair of columns which is 8 columns from the first column. If my assumption is correct then have a go at this:
For i = 0 To (ProgramCount * 8) Step 8
With Worksheets("Sheet1").Range("A2:A20").Offset(, i + 3)
.FormulaR1C1 = "=IF(RC[-3]=RC[-1],0,IF(RC[-3]>RC[-1],1,2))"
.Value2 = .Value2
End With
Next
Adjust the offset to suit your needs (I may have misunderstood the actual columns you target to update). Hope this helps.
I am trying to merge the cells in a column (column B) based on a condition in another column (Column C).
In Column C, I have a list that starts at 1 and goes to a maximum of 10. However, it may stop at any number before 10 and restart. For Example:
B C
1
2
3
4
5
6
1
2
3
4
1
2
3
4
5
1
As you can see, at B7 and B11, Column C starts over a 1. When this happens, I would like to merge everything above that restart (from 1 to last number before restart). So for this example, I would like to merge B1:B6, B7:10, and B11:15.
This short loop using the WorksheetFunction object MATCH function to locate 'ones' should suffice.
Dim srw As Long, frw As Variant
With Worksheets("Sheet1")
With Intersect(.Columns(3), .UsedRange)
srw = 0
Do While srw < .Rows.Count
frw = Application.Match(1, .Columns(1).Offset(srw + 1, 0), 0)
If Not IsError(frw) Then
.Cells(srw + 1, 1).Resize(frw, 1).Offset(0, -1).Merge
srw = srw + frw
Else
srw = .Cells(Rows.Count, 1).End(xlUp).Row
End If
Loop
End With
End With
It's just a matter of finding the restarting point (the 'ones') and using a little maths to resize the cells to be merged.
an alternative code pattern, using a formula approach with a helper column (cleared before ending) by which jumping through relevant rows only
Option Explicit
Sub test()
Dim i As Long
With Worksheets("Sheet001")
With .Columns(3).SpecialCells(xlCellTypeConstants, xlNumbers)
With .Offset(, 1)
.FormulaR1C1 = "=if(RC[-1]=1,"""",1)"
.Value = .Value
With .SpecialCells(xlCellTypeBlanks)
For i = 1 To .Areas.Count - 1
Range(.Areas(i).Cells(.Areas(i).Count), .Areas(i + 1).Cells(1).Offset(-1)).Offset(0, -2).Merge
Next i
End With
.ClearContents
End With
End With
End With
End Sub
I need to Loop the formula below until Column "B" which contains dates is empty.
I am stuck and I just can't seem to write the VBA Code to do the Loop until there is no more Dates in Column "B". The formula is smoothing out the yields by using those dates that have a yield.
I hope anyone would be able to help me. Thanks in advance
A B C D
5 Factor Date Yield Input
6 3 May-10 .25
7 1 Jun-10
8 2 Jul-10
9 3 Aug-10 0.2000
10 1 Sep-10
11 2 Oct-10
12 3 Nov-10 0.2418
13 1 Dec-10
14 2 Jan-11
15 3 Feb-11 0.3156
16 1 Mar-11
17 2 Apr-11
Sub IsNumeric()
' IF(ISNUMBER(C6),C6,
If Application.IsNumber(range("c6").Value) Then
range("d6").Value = range("c6")
' IF(C6<C5,((OFFSET(C6,2,0)-OFFSET(C6,-1,0))*A6/3+OFFSET(C6,-1,0)),
If range("c6").Select < range("c5").Select Then
range("d6").Value = range("c6").Offset(2, 0).Select - range("c6").Offset(-1, 0).Select * (range("a6").Select / 3) + range("c6").Offset(-1, 0).Select
' IF(C6<>C7,((OFFSET(C6,1,0)-OFFSET(C6,-2,0))*(A6/3)+OFFSET(C6,-2,0)),"")))
If range("c6").Select <> range("c7").Select Then
range("d6").Value = (range("c6").Offset(1, 0).Select) - range("c6").Offset(-2, 0).Select * (range("a6").Select / 3) + range("c6").Offset(-2, 0).Select
Else
range("d6").Value = ""
End If
End If
End If
End Sub
Sub Test01()
Dim m, r, cell As Object
Dim n As Boolean
Set m = Sheets("Sheet1").Cells(1, 2)
Do
Set m = m.Offset(1, 0)
Set r = m.Resize(20, 1)
n = False
For Each cell In r
If cell.Formula <> "" Then
n = True
End If
Next cell
MsgBox m.Formula
Loop Until n = False
End Sub
This will start at B1 and loop all the way down Column B until the loop encounters a cell at which, beneath it, are 20 contiguous blank cells. When the loop arrives at that cell that has 20 consecutive blanks cells beneath it, it will just Offset to the first of those blank cells beneath it and stop.
If I understand it correctly...
You'll need to convert hard coded ranges to variables
You are using offset correctly
I know while/wend is outdated, sorry :)
Sub IsNumeric()
dim tc as range
set tc = range("B6") 'this is always column B, but the row keeps changing in the loop
'IF(ISNUMBER(C6),C6,
while tc <> ""
If Application.IsNumber(tc.offset(0,1).Value) Then
tc.offset(0,2).Value = tc.offset(0,1)
'IF(C6<C5,((OFFSET(C6,2,0)-OFFSET(C6,-1,0))*A6/3+OFFSET(C6,-1,0)),
If tc.offset(0,1) < tc.offset(-1,1) Then
tc.offset(0,2).Value = tc.Offset(2, 1) - tc.Offset(-1, 1) * (tc.offset(0,-1) / 3) + tc.Offset(-1, 1)
'IF(C6<>C7,((OFFSET(C6,1,0)-OFFSET(C6,-2,0))*(A6/3)+OFFSET(C6,-2,0)),"")))
If tc.offset(0,1) <> tc.offset(1,1) Then
tc.offset(0,2) = tc.offset(1,1) - tc.offset(-2,1) * (tc.offset(0,-1) / 3) + tc.offset(-2,1)
Else
tc.offset(0,2) = ""
End If
End If
End If
set tc=tc.offset(1,0)
wend
End Sub