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
Related
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
New to VBA if someone could help me what im doing wrong here.
Trying to run a loop such that it looks for a specific text, starts the loop then stops at a specific point.
The loops is such that I want it to copy some values below in my sheet hence a is 55.
Im facing the error Block IF without End If
Here is the code:
Private Sub CommandButton3_Click()
For y = 1 To 15 Step 5
Dim x As Double
Dim a As Double
x = 1
a = 55
If Cells(x, y).Value = "Text1" Then
Do Until Cells(x, y).Value = "Text2"
Cells(a, y) = Cells(x, y).Value
Cells(a, y + 1) = Cells(x, y + 1)
x = x + 1
a = a + 1
Loop
End Sub
Indenting is the way forward, you have a for statement with no next and an if with no End If:
Private Sub CommandButton3_Click()
For y = 1 To 15 Step 5
Dim x As Double
Dim a As Double
x = 1
a = 55
If Cells(x, y).Value = "Text1" Then
Do Until Cells(x, y).Value = "Text2"
Cells(a, y) = Cells(x, y).Value
Cells(a, y + 1) = Cells(x, y + 1)
x = x + 1
a = a + 1
Loop
End If
Next y
end sub
Besides the issues I mentioned in the comments to your post, if I understood you correctly, you want to loop on cells at Column A, find the first "Text1", then copy all the cells to row 55 and below, until you find "Text2". If that's the case, try the code below :
Private Sub CommandButton3_Click()
Dim x As Long, y As Long
Dim a As Long
Dim LastRow As Long
With Worksheets("Sheet1") '<-- modify "Sheet1" to your sheet's name
For y = 1 To 15 Step 5
x = 1 '<-- reset x and a (rows) inside the columns loop
a = 55 '<-- start pasting from row 55
LastRow = .Cells(.Rows.Count, y).End(xlUp).Row
While x <= LastRow '<-- loop until last row with data in Column y
If .Cells(x, y).Value Like "Text1" Then
Do Until .Cells(x, y).Value = "Text2"
.Cells(a, y).Value = .Cells(x, y).Value
.Cells(a, y + 1).Value = .Cells(x, y + 1).Value
x = x + 1
a = a + 1
Loop
End If
x = x + 1
Wend
Next y
End With
End Sub
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
I am trying to verify that there are no error between the value in cells on column A and in Column C.
I keep getting an error saying "Next Without For"
Sub ISIN()
Dim i As Integer
Dim y As Integer
Dim t As Integer
Dim z As Integer
For i = 20 To 53
For y = 6 To 38
For t = 20 To 53
For z = 53 To 87
If Cells(i, 3) = Cells(y, 1) Then
Cells(t, 19) = "Abracadabra"
Else: Cells(z, 3) = Cells(y, 1)
Next z
Next t
Next y
Next i
End If
End Sub
you need to close the if statement before you can use the next keyword
Sub ISIN()
Dim i As Integer
Dim y As Integer
Dim t As Integer
Dim z As Integer
For i = 20 To 53
For y = 6 To 38
For t = 20 To 53
For z = 53 To 87
If Cells(i, 3) = Cells(y, 1) Then
Cells(t, 19) = "Abracadabra"
Else
Cells(z, 3) = Cells(y, 1)
end if
Next z
Next t
Next y
Next i
End Sub
So new to coding completely. here is question :
How do I make a code that finds a multiple of a number within a set.
Ex. I have a set of number: I want to order the number beginning with the first number with every pair that is 14 a part. I was able to figure out how to do this (See code below) But now I want to do another code looking for multiples of 14 so.. It would look at x, and then find (x*14), (x*(2*14)), etc.. Any help would be appreciated
Column A Column B
459
452
426
485
425
Sub GetPairs()
Dim x, z As Single
Dim lastrow, pasterow As Single
Dim testMass, nomMass As Single
lastrow = Worksheets(1).Cells(Rows.Count, 2).End(xlUp).Row
pasterow = 2
For x = 2 To lastrow
nomMass = Cells(x, 2).Value
testMass = Cells(x, 2) + 14
o
r z = 2 To lastrow
If Cells(z, 2).Value = testMass Then
Cells(pasterow, 7).Value = nomMass
Cells(pasterow, 8).Value = Cells(z, 2).Value
pasterow = pasterow + 1
End If
Next z
Next x
End Sub
Actually, it should be that simple.
multiple = Cells(x*14, 2)
I think that should do what you want.
Yes That worked perfectly.
Here is the final code I came up with :
Sub GetPairs()
``Dim x As Single, z As Single
Dim lastRow, pasterow As Single
Dim testMass, nomMass As Single
`` Dim lastValue As Long
` Dim colCounter As Long
``Dim lookUpRange As Range
`lastRow = Worksheets(1).Cells(Rows.Count, 2).End(xlUp).Row
`lastValue = Worksheets(1).Cells(Rows.Count, 2).End(xlUp).Value
`Set lookUpRange = Worksheets(1).Range("B2:B" & lastRow)
``pasterow = 2
`For x = 2 To lastRow
nomMass = Cells(x, 2).Value ' base value
colCounter = 3
For z = Round((nomMass + 14), 0) To Round((lastValue + 14), 0) Step 14
If Found(lookUpRange, z) Then
'found
Worksheets(1).Cells(x, colCounter) = z
colCounter = colCounter + 1
End If
Next z
Next x
End Sub
Private Function Found(rng As Range, valueToFind) As Boolean
On Error GoTo errHandler
Dim v
v = WorksheetFunction.VLookup(valueToFind, rng, 1, 0)
Found = True