so I am getting errors for some reason "next without for"
here is the code:
Sub test()
Dim y As Integer
y = 0
For i = 1 To 7
For j = 1 To 7
If Cells(i, 1) = Cells(j, 1) Then
y = y + 1
Next j
Cells(i, 2).Value = y
y = 0
Next i
End Sub
The problem doesn't come from your For ... To ... Next but from your If condition that you forgot to close with the End If instruction.
Sub test()
Dim y As Integer
y = 0
For i = 1 To 7
For j = 1 To 7
If Cells(i, 1) = Cells(j, 1) Then
y = y + 1
End If 'You forgot to end the condition
Next j
Cells(i, 2).Value = y
y = 0
Next i
End Sub
Related
UDF aim: Compare the value of the range with the specific cells on the same sheet.
Error occurs #Value!.
I think , that the problem in setting the pass to this cell ThisWorkbook.ThisWorksheet. How to do it competently?
Function Fav(Diapozon As Range) As Long
Application.Volatile
Dim n As Long
For x = 1 To 4
For y = 0 To 1
If Diapozon.Value = ThisWorkbook.Thisworksheet.Cells(x + 29, y + 10).Value Or _
Diapozon.Offset(0, 1).Value = ThisWorkbook.Thisworksheet.Cells(x + 29, y + 10).Value Then
n = 1
End If
Next y
Next x
Fav = n
End Function
Correct. Perhaps you meant Activesheet?
Public Function Fav(ByVal Diapozon As Range) As Long
Application.Volatile
Dim n As Long, x As Long, y As Long
For x = 1 To 4
For y = 0 To 1
If Diapozon.Value = ThisWorkbook.ActiveSheet.Cells(x + 29, y + 10).Value Or Diapozon.Offset(0, 1).Value = ThisWorkbook.ActiveSheet.Cells(x + 29, y + 10).Value Then
n = 1
End If
Next y
Next x
Fav = n
End Function
If you are using this only in the sheet as an UDF then drop the sheet reference:
Public Function Fav(ByVal Diapozon As Range) As Long
Application.Volatile
Dim n As Long, x As Long, y As Long
For x = 1 To 4
For y = 0 To 1
If Diapozon.Value = Cells(x + 29, y + 10).Value Or Diapozon.Offset(0, 1).Value = Cells(x + 29, y + 10).Value Then
n = 1
End If
Next y
Next x
Fav = n
End Function
Good day to all,
I keep getting the same runtime error while executing my code. I don't have formal training in VBA (mostly some VB in highschool).
The code is this
Sub Lavaggi2():
Dim i, j, k, lavaggio, x, daymax As Integer
Dim day As Date
Dim Ore(10) As Single
Dim column_len, row_len As Integer
Dim totale_ore As Integer
'Determining variable for row and columns
column_len = Sheets("Foglio7").Cells.CurrentRegion.Columns.Count
row_len = Sheets("Foglio7").Cells.CurrentRegion.Rows.Count
k = 1
For j = 1 To row_len
For i = 1 To column_len
If (Sheets("Foglio7").Cells(2, i).Value = "Codice") Then
If (Sheets("Foglio7").Cells(j, i).Value = "00/100" Or Sheets("Foglio7").Cells(j, i).Value = "00/200") Then
day = Sheets("Foglio7").Cells(j, 1).Value
For k = 1 To 10
If (Sheets("Foglio7").Cells(j - k, 1).Value = day) Then
Ore(k) = Sheets("Foglio7").Cells(j - k, i + 5).Value
daymax = daymax + 1
Else
End If
Next k
totale_ore = Worksheet.funcion.Sum(Ore)
lavaggio = Sheets("Foglio7").Cells(j, i + 7) / totale_ore
For x = 1 To daymax
Sheets("Foglio7").Cells(j - x, i + 7).Value = lavaggio * Ore(x)
Next x
Erase Ore
End If
End If
Next i
Next j
End Sub
The line where I get the error is
If (Sheets("Foglio7").Cells(j - k, 1).Value = day) Then
I'm quite sure it's something silly but I'm unable to wrap my head around it.
PS: I'm aware that the code is probably a little clunky but I'll streamline it at a future stage.
Thanks to all who will answer
On your first iteration of the loop, j - k would equal 0, and your cell would be .Cells(0, 1), which doesn't exist.
I managed to solve the issues I encountered. It works as intended. Thanks to all for the help
Sub Lavaggi2():
Dim i, j, k, x, daymax As Integer
Dim day As Date
Dim lavaggio, totale_ore, Ore(10) As Double
Dim column_len, row_len As Integer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
column_len = Sheets("Foglio7").Cells.CurrentRegion.Columns.Count
row_len = Sheets("Foglio7").Cells.CurrentRegion.Rows.Count
daymax = 1
For j = 1 To row_len
For i = 1 To column_len
If (Sheets("Foglio7").Cells(2, i).Value = "Codice") Then
If (Sheets("Foglio7").Cells(j, i).Value = "00/100" Or Sheets("Foglio7").Cells(j, i).Value = "00/200") Then
day = Sheets("Foglio7").Cells(j, 1).Value
For k = 1 To 10
If (Sheets("Foglio7").Cells(j - k, 1).Value = day) Then
Ore(k) = Sheets("Foglio7").Cells(j - k, i + 5).Value
daymax = daymax + 1
Else
Exit For
End If
Next k
totale_ore = Application.WorksheetFunction.Sum(Ore)
lavaggio = Sheets("Foglio7").Cells(j, i + 7) / totale_ore
For x = 1 To daymax - 1
Sheets("Foglio7").Cells(j - x, i + 7).Value = lavaggio * Ore(x)
Next x
daymax = 1
Erase Ore
End If
End If
Next i
Next j
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
I also tweaked the declarations in order to achieve the desired precision in the final results.
I am trying to construct and If statement that turns a tab Red if two of three cells are colored, or Turns green if only on is colored. I was hoping that there would be an easier way to right it than three if statements like this.
Dim dateRng As String, num As Integer, j As Integer, irng As Range, frng As Range
dateRng = Sheets("Input Raw Data").Range("B" & counter + 2).Value
num = Sheets("Tool Setup").Range("C18").Value
NumPts = num * 3
For s = 1 To Sheets.Count
With Sheets(s)
For j = 1 To num
If .Name = j Then
.Range("A1:C1").Merge
.Range("A1") = dateRng
.Name = Sheets("Point Names").Range("B" & (3 * j - 1))
End If
Next j
End With
Next s
For s = 1 to Sheets.Count
With Sheets(s)
For y = 1 To NumPts
If .Name = Sheets("Reporting").Range("B" & (12 * y - 5)) Then
For k = 6 To -1
Set irng = Sheets("Reporting").Range("A" & (12 * y - k))
Set irng = Sheets("Reporting").Range(irng, irng.End(xlToRight).End(xlToRight))
irng.Copy (.Range("A2"))
Next k
.Columns("A:A").ColumnWidth = 12
.Columns("B:B").EntireColumn.AutoFit
If .Range("B7").Interior.ColorIndex > 0 Then
a = 1
End If
If .Range("B8").Interior.ColorIndex > 0 Then
a = a + 1
End If
If .Range("B9").Interior.ColorIndex > 0 Then
a = a + 1
End If
If a >= 2 Then
.Tab.ColorIndex = 3
ElseIf a <= 1 Then
.Tab.ColorIndex = 4
End If
End If
y = y + 2
Next y
End With
Next s
Something like this may help you. It still has multiple if statements. But the statements are simple and don't have to deal with how the combinations of different cells being colored.
Also, I used colorindex > 0 as the condition for having color filling.
a = 0
If .Range("B7").Interior.ColorIndex > 0 Then
a = 1
End If
If .Range("B8").Interior.ColorIndex > 0 Then
a = a + 1
End If
If .Range("B9").Interior.ColorIndex > 0 Then
a = a + 1
End If
If a = 2 Then
.Range("B10").Interior.ColorIndex = 3
ElseIf a = 1 Then
.Range("B10").Interior.ColorIndex = 43
End If
I have a program Sub which works well. I want to convert it into a custom Function, but when I use this function in Excel an error (#VALUE!) occurs
Function ТридцатьТРи(Diapozon As Integer)
'для п/пр
Dim k, n As Integer
Dim parRange As Range
Set parRange = Range("Diapozon")
k = 0
n = 0
For Each Cell In parRange.Rows
If Cell.Offset(0, 1).Value = 1 And k = -1 Then
n = n - 1
End If
If Cell.Value = 1 And k = -1 Then
n = n + 1
End If
If Cell.Value = 1 Then
k = k + 1
If k = 2 Then
k = -1
End If
End If
If Cell.Value = 2 Or Cell.Value = 3 Then
k = 0
End If
Next Cell
ТридцатьТРи = n
End Function
Try the UDF code below (not sure about what you are trying to achieve with your logics inside the UDF), but it works (not getting #VALUE!).
Since you want to pass a Range object to the UDF (according to your screen-shot), you need to define it also in your Function code.
Code
Function cyrilic(Diapozon As Range) As Long
Dim k As Long, n As Long
Dim C As Range
k = 0
n = 0
For Each C In Diapozon.Rows
If C.Offset(0, 1).Value = 1 And k = -1 Then
n = n - 1
End If
If C.Value = 1 And k = -1 Then
n = n + 1
End If
If C.Value = 1 Then
k = k + 1
If k = 2 Then
k = -1
End If
End If
If C.Value = 2 Or C.Value = 3 Then
k = 0
End If
Next C
cyrilic = n
End Function
This will work as a worksheet function apperently, you need to input the range that you previousely defined with a named range "diapozon" as an input range.
Function cyrillic(rng As Range)
Dim k, n As Integer
Dim parRange As Range
Set parRange = rng
k = 0
n = 0
For Each Cell In parRange.Rows
If Cell.Offset(0, 1).Value = 1 And k = -1 Then
n = n - 1
End If
If Cell.Value = 1 And k = -1 Then
n = n + 1
End If
If Cell.Value = 1 Then
k = k + 1
If k = 2 Then
k = -1
End If
End If
If Cell.Value = 2 Or Cell.Value = 3 Then
k = 0
End If
Next Cell
cyrillic = n
End Function
Just type : =cyrillic("R1:RX") and it should work.
My problem is the as follows:
I have 3 columns and 20 rows, that contains numbers.
There is a line with numbers between 1 to 20 in order crescente, the other cells contains bigger numbers then 100 or whatever.
My homework is that I have to write a VBA code which fill color the cells that contains the line. This way i going to have a "colorful snake" from the cells that contains the numbers between 1 to 20.
Of course, the starting number cell is "A1"
the ending cell can be anywhere in the area "A1:C20"
the substance is the colored cells must have follow the numbers in order cresence!
Sub MeykEhYewowSnakhey()
Dim r, c
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets(1)
For r = 1 To ws.UsedRange.Rows.Count
For c = 1 To ws.UsedRange.Columns.Count
If ws.Cells(r, c).Value < 100 Then
ws.Cells(r, c).Interior.ColorIndex = 6
End If
Next
Next
End Sub
Try that.
There is probably a much more efficient way to solve this but this is my solution.
Sub Snake()
Dim wbk As Workbook
Dim ws As Worksheet
Dim mySnake As Integer, x As Integer, y As Integer
Set wbk = Workbooks("Book1.xlsm")
Set ws = wbk.Worksheets("Sheet1")
x = 1
y = 1
With ws
For mySnake = 1 To 20
If .Cells(x, y) = mySnake Then
.Cells(x, y).Interior.Color = vbYellow
'Check cell below
If .Cells(x + 1, y) = mySnake + 1 Then
x = x + 1
'Check cell to right
ElseIf .Cells(x, y + 1) = mySnake + 1 Then
y = y + 1
'Check cells to left if y <> 1
ElseIf y <> 1 Then
If .Cells(x, y - 1) = mySnake + 1 Then
y = y - 1
End If
'Check cells above if x <> 1
ElseIf x <> 1 Then
If .Cells(x - 1, y) = mySnake + 1 Then
x = x - 1
End If
End If
End If
Next mySnake
End With
End Sub