I'm going to start my problem with an example, as otherwise it will be too difficult to explain.
A B C D E (ID)
1 word letter 1
test blabla
other
2 word letter 2
number
3 test true 3
4 other false 4
5 word letter Yes 5
6 word letter Yes 6
7 test letter 7
What's the goal?
If I'll try to explain the goal in words, it will be hard to understand; it's also hard to explain :) Anyway I also added my code, and if you are good with VBA you will understand the code better then the text.
IF a value (in this example: word) is also in other rows THEN we needs to check column C, AND IF there is a value in column C that we find more then once in column C (in this example: letter), we needs to recheck if in column A the value also appears more then once.
So I already made a SUB, AND IT WORKS ! :) BUT not if there are more values in a cell. So in the example when there is only 1 value in a cell, as in row 6 & 7, column D returns : YES
Here is my code so far.
Sub duplicates()
Dim source As Range
Dim source2 As Range
For Each source In Range("A1", Range("A" & Rows.Count).End(xlUp))
If source.Value <> "" Then
For Each source2 In Range("A1", Range("A" & Rows.Count).End(xlUp))
If source.Value = source2.Value And source.Offset(0, 4).Value <> source2.Offset (0, 4).Value Then
If source.Offset(0, 2).Value = source2.Offset(0, 2).Value Then
source.Offset(0, 3) = "Yes"
End If
End If
Next source2
End If
Next source
End Sub
So, we should return: YES in row 1 & 2 as well. Hope you understand my goal.
Hope someone can help.
My proposal is as follows:
A) additional function would check each element of each cell passed to the function as array:
Function AnyEqual(ColA, ColB) As Boolean
Dim itemA, itemB
For Each itemA In ColA
For Each itemB In ColB
If itemA = itemB Then
AnyEqual = True
Exit Function
End If
Next
Next
End Function
B) Some changes are made in your code- put it inside For Each source2 loop instead your inner code:
If AnyEqual(Split(source, Chr(10)), Split(source2, Chr(10))) And _
source.Offset(0, 4).Value <> source2.Offset(0, 4).Value Then
If AnyEqual(Split(source.Offset(0, 2), Chr(10)), _
Split(source2.Offset(0, 2), Chr(10))) Then
source.Offset(0, 3) = "Yes"
End If
End If
Based on data you provided it seems it works fine. I hope it is what you were looking for as it was a bit complicated to understand your needs.
Related
Dear Community I need your help and I dont know how to solve this problem.
I need to compare the "Team(A)" "Number(D)" (here it is 1)
with the number "12(E)"
in an extra row (F)
When I have done this, the next "Team(A) "Number(D)" (here it is 2)
with the number "10(E)"
in an extra row (F) under the other and so on.
It should look like this:
Row(F)
1 - 12
2 - 10
3 - 12
4 - 16
Is there any solution ? I cant adress the column because it could be variable.
can you help me please. By the way, I am new at VBA.
Thank you so so much :)
You could make it simple and work with "Selection".
To use my example-script you would have to mark the column with the first value and then start the makro.
(The second value would always have to be one column to the right of it and two rows below.)
Sub TeamCompare()
Dim c As Range
Dim a As String
Dim b As String
For Each c In Selection
If Not c.Value = "" Then
a = c.Value
b = ActiveSheet.Cells(c.Row + 2, c.Column + 1).Value
ActiveSheet.Cells(c.Row, c.Column + 2).Value = a & " - " & b
End If
Next c
End Sub
I am trying to write excel VBA code that will parse column B (analyst login time), and if that column is 0 (as in they were out that day), it will update the adjacent columns to say NA. Currently, the below code errors out. If I change the rng variable in Cells(rng, i) to a number, then the code will take that number (let's say 4) and put NA in all of the fields (3 to 23, so, C to W). I believe that the issue is that the value of rng is not being passed into the inner function, but I do not know how to get arround this.
Dim rng As Range
For Each rng In Range("B4:B10")
If rng.Value = 0 Then
For i = 3 To 23
Cells(rng, i).Value = NA
Next i
End If
Next rng
rng on its own (without an explicit property name) defaults to returning .Value which when 0 tries to use row index 0 which is not valid, instead get the row number via .Row:
Cells(rng.Row, i).Value = "NA"
If NA is not a variable but a string, quote it.
Non-loop alternative:
If rng.Value = 0 Then Range(rng.Offset(0, 1), rng.Offset(0, 21)).Value = "NA"
Problem is here:
Cells(rng, i).Value = "NA"
why you give range to place where Number (row number) must go?
You need to use
Cells(rng.Row, i).Value = "NA"
Without using VBA (I can do it in VBA, but just want to try whether a macro can do it as well, but I haven't figured it out yet),
I have two sheets. Sheet A includes a column of names such as its cell like:
Wright
Sheet B includes a column of names well, but with more letters like title in one cell such as:
Mr. Wright
Sheet A to B is in a relationship of one-to-many (Wright in Sheet A might have multiple rows with Mr.Wright in Sheet B).
If in Sheet B, how to write a macro with some function to achieve: to check whether 'Mr.Wright' has a substring in a cell in Sheet A.
(I think about it might be easier to start from Sheet A: might with regex, find all matches in Sheet B with INDEX or MATCH first. It's much better if it can be done from Sheet B in one shot)
Create a macro called sub_in_name.
Option Explicit
Sub sub_in_name()
Dim x, i As Long
Dim endofcells1, endofcellsmany As Long
endofcells1 = WorksheetFunction.CountA(Range("A:A"))
endofcellsmany = WorksheetFunction.CountA(Range("B:B"))
For x = 1 To endofcells1
For i = 1 To endofcellsmany
If (InStr(1, Cells(i, 2), Cells(x, 1), vbTextCompare)) Then
Cells(i, 2 + x).Value = "True"
Else
Cells(i, 2 + x).Value = "False"
End If
Next i
Next x
End Sub
Intr(start, SearchStr, SearchInStr, vbaoption) is the main function to make this work. Cells(i, 2 + x) is indexed based off the number of non-empty cells in column "A"
Make sure to clear the cells content for each trial; after column "B".
For example put in Column "A" & Column "B" and you will get columns "C:D"
Column "A" Column "B" Column "C" Column "D"
Wright Mr. Wright True False
Roger Wright Jr. True False
Wright the Ivth. True False
Sally False False
Roughly similar logic. Originally I wanted to use existing macro functions to do it. Finally it ended up like making a customized function like below:
Inspired by another thread in stack overflow. I made a code to do full checking like user3553260's. But I think a function is not a bad choice as well, considering if the efficiency is not the top one concern here.
Function LookupName(lookupValue As Variant, lookupRange As Range) As String
Dim r As Long
Dim c As Long
Dim s As String
s = "No"
For r = 1 To lookupRange.Rows.Count
For c = 1 To lookupRange.Columns.Count
If Not IsEmpty(lookupRange.Cells(r, c).Value) Then
If InStr(LCase(lookupValue), LCase(lookupRange.Cells(r, c).Value)) Then
s = "Yes"
Exit For
End If
End If
Next
Next
LookupName = s
End Function
I will use an example to illustrate my question:
I have many tables which their lines quantity is different.
I want to pull down the function until the end of the table.
For example:
A B
1 =1*2 // <- this is the function that I want to pull
2
3
4
The output should be:
A B
1 =1*2
2 =2*2
3 =3*2
4 =4*2
It is important that the pull length is determined by the last cell at column A (in this case it is 4)
Please also note that the function may be changed either, this should work for any function.
Thank you,
Doron
Here is an example of a macro that will autofill the value from cell B1 to the end of the column to the left of it (in this case column A).
Sub AutoFill()
Dim FillFrom As Range
Set FillFrom = ActiveSheet.Range("B1")
FillFrom.AutoFill Destination:=Range(FillFrom.Address, FillFrom.Offset(0, -1).End(xlDown).Offset(0, 1).Address)
End Sub
Try This:
Public Sub DoWhatIWantYouToDo()
Dim lr As Integer, i As Integer
lr = Sheets("Sheet1").UsedRange.Rows.Count
For i = 2 To lr
Sheets("Sheet1").Range("B" & i).Formula = "=" & " A" & i & "*2"
Next
End Sub
SO this started as me trying to help someone else, got stumped. So basically i have values in columns B, C, and D. if have my criteria in H2 and I2 and when my criteria in H2 and I2 matches in B and C then have the corresponding answer in D to populate J2. basically a vlookup with 2 criteria.
i have something like this.
Sub test()
Dim rngCrit1 As Range
Dim rngCrit2 As Range
Dim rngAnswer As Range
Dim strTarget As String
Set rngCrit1 = Range("H2")
Set rngCrit2 = Range("I2")
Set rngAnswer = Range("J2")
Range("B2").Select
strTarget = ActiveCell.Value
Do While strTarget <> ""
With ActiveCell
If strTarget = rngCrit1 Then
If .Offset(0, 1).Value = rngCrit2 Then
rngAnswer.Value = .Offset(0, 2)
Else
.Offset(1, 0).Select
strTarget = ActiveCell.Value
End If
End If
End With
Loop
End Sub
Now this thing just crashes, no debugging or anything. I am self taught so i'm sure i screwed the pooch here somewhere.
*Note this is just to satisfy my own interest not really important, so if it takes you more than 5 min please help someone else that needs it more than I.
Val1 Val2 Val3 Crit1 Crit2 Answer
a r 12 g v 22
b r 14
c s 15
d s 16
e t 18
f t 19
g y 20
g v 22
sample data
It's great that you're trying to improve your VBA skills. The first thing I'd suggest, which will improve any macro you write, is to avoid using .Select. Work directly with the range objects. For instance:
Range("B2").Select
strTarget = ActiveCell.Value
becomes
strTarget = Range("B2").Value
Also, in general, use vbNullString or Len(variable)=0 when checking for "empty" values instead of "". As for why your program is crashing, it may be your use of With. Like Select, it should be avoided in most cases (definitely in this one). Although you update ActiveCell, it's within the scope of the With statement, so once you close it (End With), those changes to ActiveCell are undone (I would suggest stepping through the macro and watch the values of strTarget and ActiveCell). This may not be the case, but I know it holds for other variables, which is why I avoid With (and avoid reassigning values in a With statement)
Anyway, I'd add the following code and rewrite the loop as follows:
Dim r as range
set r = Range("B2") 'keep in mind this range is on the ActiveSheet, so you're better
'off explicitly naming the Sheet e.g. Sheet1.Range("B2")
strTarget1 = Range("B2").Value
strTarget2 = Range("C2").Value
Do While Len(strTarget) <> 0
If strTarget1 = rngCrit1 Then
If strTarget2 = rngCrit2 Then
rngAnswer.Value = r.Offset(0,2)
Exit Do
End If
End If
set r = r.Offset(1,0)
strTarget1 = r.Value
strTarget2 = r.Offset(0,1).Value
Loop
Keep in mind you could also loop with a Long counter i for the row, then call Sheet1.Cells(i,1).Value, Sheet1.Cells(i,2).Value and so on for the values of the different columns of that row (instead of using a range object and .Offset
EDIT: After running your code, the reason for the crash is due to your If statements. You want to go to the next cell regardless. Remove the Else and put the End If statements before the Select. Add an Exit Do after your assignment statement in the 2nd If, since you want to stop looping if your two columns meet the criteria. I've updated my code to show this, as well.
INDEX and MATCH, or SUMPRODUCT tend to work well for this. An example of the former:
http://support.microsoft.com/kb/59482
if you can guarantee val1 and val2 will be unique (e.g. when searching for g & v, there is only 1 line with g and v) then you can use sumifs
I put val1,val2 and val3 in columns A,B, & C, and the search into E,F and the answer in G, and came up with this formula
=SUMIFS(C2:C9,A2:A9,E2,B2:B9,F2)
of course, this fails if val3 is not numeric, or there are more than 1 line with the letters you are looking for