I'm trying to make a combobox that gets its values from a range. I only want to see unique values and it must be sorted in alphabetical order (case insensitive).
Everything works fine except the sorting of data. Sorting is case sensitive but this is not what I want.
Sorting is like:
Door
Room
Window
kitchen
But the way I want it:
Door
kitchen
Room
Window
Below you can find my code:
Dim x, a, b As Long, c As Variant
Dim DataRng As String
Worksheets("House").Activate
'Unique Records
For x = 2 To Cells(Rows.Count, 4).End(xlUp).Row
If WorksheetFunction.CountIf(Range("D2:D" & x), Cells(x, 4)) = 1 Then
ComboBox1.AddItem Cells(x, 4).Value
End If
Next
'Alphabetic Order
For a = 0 To ComboBox1.ListCount - 1
For b = a To ComboBox1.ListCount - 1
If ComboBox1.List(b) < ComboBox1.List(a) Then
c = ComboBox1.List(a)
ComboBox1.List(a) = ComboBox1.List(b)
ComboBox1.List(b) = c
End If
Next
Next
End Sub
I hope someone can solve my problem or can give me a hint.
try ucase(ComboBox1.List(b))... or option compare text perhaps
Related
I have two tables. One table is called DRData (Blad3), other table is CheckData (Blad2). EANCODE is Column J for DRData, and Column A for Checkdata.
I want to check whether CheckData.EANCODE is present in DRData.EANCODE. If so; delete that row from CheckData.
I tried several things, but no success yet. The code I have written now is as follows:
Sub FindEAN()
Dim i As Long
Dim x As Long
x = 1 'Start on first row
EANtoFind = Blad2.Range("A" & x).Value
For i = 1 To 99999 '
If Blad3.Cells(i, 1).Value = EANtoFind Then
Blad2.Range("A" & x).EntireRow.Delete
Else: x = x + 1
End If
Next i
End Sub
When the EANCODE is not present, I want to hop over a row to check that code. I want to end with a list in CheckData where all the EANCODE values that are not in DRData are shown.
With the code above, only the first row is getting deleted and now I'm stuck how to get this to loop. Including the x+1 to get to the next row.
First you have to clarify that your problem is a little bit complicated. You have to pay attention to indexes when deleting rows
To do that, you have to point the the maximal number of line to optimize your loop
A simple way to do that, is to use predefined search function, and edit your code a little bit.
My favorite is Application.match(), which takes 3 parameters :
Value to look for
Array where you look (in our case the column J of Blad3 or position 10)
0 : exact match
For more details, see the documentation
https://learn.microsoft.com/fr-fr/office/vba/api/excel.worksheetfunction.match
An example of code which works is like the following
Sub FindEAN()
Dim x As Long
x = 1 'Start on first row
maxline = Blad2.Range("A" & Rows.count).End(xlUp).row
While x <= maxline '
EANtoFind = Blad2.Range("A" & x).Value
If Not IsError(Application.Match(EANtoFind, Blad3.Columns(10), 0)) Then
Blad2.Range("A" & x).EntireRow.Delete
maxline = maxline - 1
Else
x = x + 1
End If
Wend
End Sub
It's rather a complex situation. I have a routine that needs to be done every other day. I have a workbook with 2 different sheets, one called "deals list", contains a table like this:
Salesman
Campaign
Name 1
Campaign A
Name 1
Campaign B
Name 2
Campaign C
Name 3
Campaign A
Name N
Campaign N
The other sheet, called "matrix", is generated by a VBA code the currently results in something like this:
Name 1
Name 2
Name 3
Name N
Campaign A
Campaign C
Campaign A
Campaign N
This variable-sized matrix can change the size of columns and rows based on the report I get. The actual workbook has much more content, I am just simplifying it with these examples. You can notice the empty cells because I don't know how to create the code to fill them. What I actually desire to be inside them is the number of campaigns each salesman is assigned to.
Desired Result:
Name 1
Name 2
Name 3
Name N
Campaign A
1
0
1
N
Campaign B
1
0
0
N
Campaign C
0
1
0
N
Campaign N
N
N
N
N
Basically what I need is to use the first row and column as parameters for a COUNTIFS to populate the matrix.
Can anyone help me with that? I'd really appreciate any tips coming my way! ;)
This is my first question in the community, I ask sorry in advance if I've done any mistakes. I feel ashamed to ask but I have no clue whatsoever on how to do this.
Function FnTwoDimentionDynamic()
Dim arrTwoD()
Dim intRows
Dim intCols
Dim i As Integer, j As Integer
intRows = Sheets("matrix").Cells(Rows.Count, 1).End(xlUp).Row - 1
intCols = Sheets("matrix").Cells(1, Columns.Count).End(xlToLeft).Column - 1
ReDim Preserve arrTwoD(1 To intRows, 1 To intCols)
'Here I am using a simple calculation just to see if will populate
'the variable range, but what I need is a COUNTIFS searching for
'the times a Salesman appears in certain Campaing
For i = 1 To intRows
For j = 1 To intCols
arrTwoD(i, j) = i * 2 + j ^ 2
Next j
Next i
Sheets("matrix").Select: Range("B2").Select
For i = 1 To intRows
For j = 1 To intCols
ActiveCell.Value = arrTwoD(i, j)
ActiveCell.Offset(0, 1).Select
Next j
ActiveCell.Offset(1, -intCols).Select
Next i
End Function
The following code makes a couple of assumptions, the first being that you are using Excel 365 and the data on the sheet deals list starts in A1.
If either of these are incorrect the code can be changed.
Also, I'm not sure how you are creating your 'matrix' so I've used code to do that at the start.
Option Explicit
Sub CreateMatrixAndCounts()
Dim wsDeals As Worksheet
Dim wsMatrix As Worksheet
Dim rngSalesmen As Range
Dim rngCampaigns As Range
Dim rngFormulas As Range
Dim arrUniqueSalesmen As Variant
Dim arrUniqueCampaigns As Variant
Set wsDeals = Sheets("Deals List")
With wsDeals
Set rngSalesmen = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
Set rngCampaigns = rngSalesmen.Offset(, 1)
arrUniqueSalesmen = Application.Sort(Application.Unique(rngSalesmen))
arrUniqueCampaigns = Application.Sort(Application.Unique(rngCampaigns))
End With
Set wsMatrix = Sheets.Add
wsMatrix.Range("A2").Resize(UBound(arrUniqueSalesmen)).Value = arrUniqueSalesmen
wsMatrix.Range("B1").Resize(, UBound(arrUniqueCampaigns)).Value = Application.Transpose(arrUniqueCampaigns)
Set rngFormulas = wsMatrix.Range("B2").Resize(UBound(arrUniqueSalesmen), UBound(arrUniqueCampaigns))
With rngSalesmen
rngFormulas.Formula = "=COUNTIFS(" & .Address(External:=True) & ", $A2, " & .Offset(, 1).Address(External:=True) & ", B$1)"
End With
End Sub
I'm trying to solve a problem in VBA and after a long time of browsing the web for solutions, I really hope someone is able to help me.
It's actually not a very hard task, but with very little programming and VBA knowledge as a new learner, I hope I can find a useful tip or solution with the help of the community.
So my problem is as follows:
I have a table with 3 columns, the first is filled with a number to use as an ID. Column 2 and 3 have different values that needs to be compared:
What I'd like to do is select the range of column rows of column 2 and 3 based on the same ID. Once I have selected the relevant ranges of the columns, I want to compare if one name of column 2 matches one name of column 3.
So there is no need to have all names of the desired column ranges to match. One name match is enough. If a name matches, it should automatically fill in a new column "result" with 1 for match (0 for no match).
Do you have an idea, how I can select specific cells of a column based on an identifier?
Dim ID_counter As Long
ID_counter = 1
If Cell.Value = ID_counter IN Range("Column1")
Then Range("Column2").Select
AND Range("Column3").Select
WHERE ID_counter is the same
In Column4 (If one Cell.Value IN Range("Column2-X:Column2-Y")
IS IDENTICAL TO Range("Column3-X:Column3-Y"), return 1, else return 0
End Sub
Many thanks in advance for your help!
This works for your example so perhaps you can generalise it. The formula in D2 is
=IF(A2=A1,"",MAX(IF($A$2:$A$10=A2,COUNTIF($B$2:$B$10,$C$2:$C$10))))
and is an array formula so must be confirmed with CTRL, SHIFT and ENTER.
Array alternative via Match() function
This approach compares the string items of columns B and C by passing two arrays (named b,c) as arguments (c.f. section [1]):
chk = Application.Match(b, c, 0)
The resulting chk array reflects all findings of the first array's items via (1-based) position indices of corresponding items in the second array.
Non-findings return an Error 2042 value (c.f. section [2]b)); assumption is made that data are grouped by id.
Sub OneFindingPerId()
'[0]get data
Dim data: data = Sheet1.Range("A1:D10") ' << project's sheet Code(Name)
Dim b: b = Application.Index(data, 0, 2) ' 2nd column (B)
Dim c: c = Application.Index(data, 0, 3) ' 3rd column (C)
'[1]get position indices of identic strings via Match() function
Dim chk: chk = Application.Match(b, c, 0) ' found row nums of a items in b
'[2]loop found position indices (i.e. no error 2042)
Dim i As Long
For i = 2 To UBound(chk) ' omit header row
'a) define start index of new id and initialize result with 0
If data(i, 1) <> data(i - 1, 1) Then
Dim newId As Long: newId = i
data(newId, 4) = 0
End If
'b) check if found row index corresponds to same id
If Not IsError(chk(i, 1)) Then ' omit error 2042 values
If data(chk(i, 1), 1) = data(i, 1) Then ' same ids?
If data(newId, 4) = 0 Then data(newId, 4) = 1 ' ~> result One if first occurrence
End If
End If
Next i
'[3]write results
Sheet1.Range("A1").Resize(UBound(data), UBound(data, 2)) = data
End Sub
First enter this user defined function in a standard module:
Public Function zool(r1, r2, r3) As Integer
Dim i As Long, v1 As Long, v2 As String
Dim top As Long, bottom As Long
zool = 0
v1 = r1.Value
top = r1.Row
' determine limits to check
For i = top To 9999
If v1 <> r1.Offset(i - top, 0).Value Then
Exit For
End If
Next i
bottom = i - 1
For i = top To bottom
v2 = Cells(i, "B").Value
If v2 <> "" Then
For j = top To bottom
If v2 = Cells(j, "C").Value Then zool = 1
Next j
End If
Next i
End Function
Then in D2 enter:
=IF(OR(A2="",A2=A1),"",zool(A2,B2,C2))
and copy downwards:
(this assumes that the data has been sorted or organized by ID first)
I have a for loop, and inside it i have if statement.
In my Excel I have a list that contains each value one time. Once I found it i don't want the code to even check the conditional, i want it to skip this part of the if statement completely each time the loop is executed, is it possible?
Here is my code and list:
the first iteration of the loop will find that "c" is the value so it will do what inside it (xc = i)
I don't want the code to even check "ElseIf Cells(1, i) = "c" again, like the following image, is this possible?
code as text:
Sub test()
Dim i, xa, xb, xc As Integer
For i = 1 To 5
If Cells(i, 1) = "a" Then
xa = i
ElseIf Cells(i, 1) = "b" Then
xb = i
ElseIf Cells(i, 1) = "c" Then
xc = i
End If
Next i
End Sub
My initial interpretation of your need was "if the code hits 'c' again, just don't act".
To do so, you could modify the logic as follows:
ElseIf (xc = 0) And (Cells(i, 1) = "c") Then
This way, as soon as xc is set, the first boolean expression would be False, and the overall condition would not ever be met again. As mentioned by #TimWilliams, VBA would still evaluate the second boolean expression, unlike other languages that feature short-circuiting options. #Gene's answer describes a way around this. Typically, for better performance, you would evaluate the simple conditions first, before resorting to costly ones.
Additional notes
In VBA, you must give a type to each variable. In your Dim line, only xc is an Integer, while the other variables are Variants.
An unqualified Cells() call operates on the currently active worksheet, which might not be the expected one. Suggestion: qualify Cells() with the CodeName of your worksheet. The CodeName is what you see or specify under a worksheet's (Name) property as seen from the Visual Basic editor. For example, if (Name) is Sheet1, use Sheet1.Cells(). This will only work if the code resides in the same workbook as Sheet1. If the code is behind the worksheet itself, you can even use Me.Cells().
When dealing with cell values as your code does, VBA is (silently) being nice and understands that, among the numerous properties of the Range class, Value is what you are interested in. It is better practice, however, to explicitly state the target property, such as in Sheet1.Cells(i, j).Value.
EDIT
Knowing the values will be distinct and that there are about 60 of them, I suggest you simply use a Dictionary, as shown below, to get each value's row in one go, without a cascade of Ifs:
Option Explicit
Sub test()
Dim i As Integer
Dim dict As Object 'Scripting.Dictionary
Set dict = CreateObject("Scripting.Dictionary")
For i = 1 To 5
dict(Cells(i, 1).Value) = i
Next
Debug.Print dict("a") '4
Debug.Print dict("b") '2
Debug.Print dict("c") '1
'Etc.
End Sub
if i understood your question you can try this code:
Sub test()
Dim i, xa, xb, xc As Integer
Dim a, b, c As Boolean
a = False
b = False
c = False
For i = 1 To 5
If Cells(i, 1) = "a" And a <> True Then
xa = i
a = True
ElseIf Cells(i, 1) = "b" And b <> True Then
xb = i
b = True
ElseIf Cells(i, 1) = "c" And c <> True Then
xc = 1
c = True
End If
Next i
End Sub
Boolean variable is setted true for example only when the cells(i,1)="a" and after the next "a" value are skipped...
hope this helps
I just wanted to "mod" Ferdinando's code so it's a bit more "readable", I think. The main (the substantive) difference between this version and Ferdinando's or Excelosaurus' is that the cell is not even tested once the value is detected. Remember that the question was: I don't want the code to even check "ElseIf Cells(1, i) = "c" again... So, this version does exactly that.
Sub test()
Dim i As Integer, xa As Integer, xb As Integer, xc As Integer
Dim aFound As Boolean, bFound As Boolean, cFound As Boolean
Dim r As Range
For i = 1 To 5
Set r = Cells(i, 1)
If Not aFound Then
If r = "a" Then xa = i: aFound = True
ElseIf Not bFound Then
If r = "b" Then xb = i: bFound = True
ElseIf Not cFound Then
If r = "c" Then xc = i: cFound = True
End If
Next i
End Sub
I don't like the idea of 60 ElseIfs. Please examine the code below. In order to test it, create a worksheet called "TestSheet" and enter your A1:A5 to cells H2:H6.
Sub TestSpike()
' 06 Jan 2019
Dim Rng As Range
Dim Items As Variant
Dim Spike As String
Dim Tmp As String
Dim i As Integer
Dim R As Long
Items = Split("c|b|0|a|1", "|")
With Worksheets("TestSheet").Columns("H")
For R = 2 To 6
Tmp = CStr(.Cells(R).Value)
If InStr(1, Spike, Tmp, vbTextCompare) = 0 Then
Spike = Spike & "|" & Tmp
On Error Resume Next
i = Application.WorksheetFunction.Match(Tmp, Items, 0)
If Err Then
MsgBox Tmp & " wasn't found in Array"
Else
MsgBox "i = " & i & " = Item " & Tmp
End If
End If
Next R
End With
End Sub
The code has a "Spike". Each item is first checked against the Spike. If it is found there no further tests are carried out. Else, it is added to the Spike.
New items, after being added to the Spike, are checked against the Array "Items" which would hold your 60 elements, separated by Chr(124) thus, Split("c|b|0|a|1", "|"). I use the worksheet function MATCH to look for the item in the array. The result is an index number (or an error, if not found). You can use this index number in a Select Case statement to process each item distinct from others, basically the same way as you now process it when the If statement returns True.
One idea you may find useful with this kind of setup is to use the index from the Match function to return a value from another array. The other array might, for example, contain function names and you use Application.Run to call a different function for each item. This would run significantly faster than examining 60-odd Select Case statements.
I have a 2 columns that look like:
field group1
a 1.2
b 0.2
c 2.4
field group2
a 0.2
c 0.8
field group3
c 0.6
d 0.8
and so forth. I have been pondering about this for a while but can't seem to find a good way.
Is there a efficient way to make the dataset look like:
field group1 group2 group3
a 1.2 0.2
b 0.2
c 2.4 0.8 0.6
d 0.8
and so forth. Any help or idea?
For a one-off, you can probably do it just with formulae to identify which groups a row is in and then pivot, as described by others in the comments to your question.
However, for repeated use / less hassle the below should work.
This works on your test data and outputs on a new sheet according to your desired output in the question.
It works in memory so it should have good performance when scaled up to thousands of cells.
Sub blah()
'Declarations
Dim outWs As Worksheet
Dim inArr, outArr
Dim vector(), groups()
Dim outC As Collection
Dim currentGroup As Long
Dim i As Long, j As Long
Dim key
'load data
inArr = Selection.Value
Set outC = New Collection
'iterate through
For i = LBound(inArr, 1) To UBound(inArr, 1)
If inArr(i, LBound(inArr, 2)) Like "field*" Then 'new group
currentGroup = currentGroup + 1
ReDim Preserve groups(1 To currentGroup)
groups(currentGroup) = inArr(i, LBound(inArr, 2) + 1) 'assign group name
Else 'is a record/field
key = inArr(i, LBound(inArr, 2))
'retrieve existing, ignoring the exception thrown if key does not exist
On Error Resume Next
vector = outC(key)
If Err.Number = 5 Then 'error raised when key does not exist
ReDim vector(0 To currentGroup)
vector(0) = key 'add key
Else
outC.Remove (key) 'the reference of item is immutable so we must remove and add again
ReDim Preserve vector(0 To currentGroup) 'resize vector
End If
On Error GoTo 0
vector(currentGroup) = inArr(i, LBound(inArr, 2) + 1) 'assign value to current group in vector
outC.Add vector, key 'add to results
Erase vector
End If
Next i
'Process our results collection into an array suitable for dumping to a sheet
ReDim outArr(1 To outC.Count, 1 To currentGroup + 1)
For i = 1 To outC.Count
For j = 0 To UBound(outC(i))
outArr(i, j + LBound(outArr, 2) - LBound(outC(i))) = outC(i)(j)
Next j
Next i
'dump data
With ActiveWorkbook.Worksheets.Add
.Range(.Cells(1, 2), .Cells(1, 1 + UBound(groups))).Value = groups
.Range(.Cells(2, 1), .Cells(1 + UBound(outArr, 1), UBound(outArr, 2))).Value = outArr
End With
Exit Sub
End Sub
I hope that helps.
so i have an idea, its not beautiful but it will probably work...
copy your whole field column and paste it to a fresh sheet, use data tab and hit remove duplicates, if you transpose that so your top row is Field, a, b, c, d you can drop a formula thats something like this (untested) "=INDEX(Sheet1!B:B, MATCH($B$1,Sheet1!A1:A3,0))"
the search range in match is intentionally small and left without $ to that if you drag this formula down it will search a little further(A2:A4,A3:A5,etc) once you get all of them just find/replace all the N/As remove blanks and your good
if i have time i will try and put together a little macro that would be a lot cleaner...
In outline: Create a copy of your group1 column, filter it for values greater than 0 and delete these. Fill the blanks with the respective groups and then pivot.
i would rearrange data first, with a macro, this way:
Sub sa()
For Each cl In Range("B2:B1000").Cells
If IsNumeric(cl.Value) And Not IsEmpty(cl.Value) Then
If Not IsNumeric(cl.Offset(-1, 0).Value) Then
cl.Offset(0, 1).Value = cl.Offset(-1, 0).Value
Else
cl.Offset(0, 1).Value = cl.Offset(-1, 1).Value
End If
End If
Next
End Sub
such that data would be rearranged with this column assignment:
[field] [value] [group]
then it would be easy to do what you want, just create a pivot table... tell me in the commentaries if in need of further help...