I've looked up info with regards to column attributes. I'm trying to perform some insertions and copying of information within an array. The crux of my issue is that I want o nest some actions within a loop, so I need to index the column by a number not letter.
The first thing I do is find a starting point based upon a header name:
Dim EnvCondCol As String
Dim EnvCondColN As Long
Dim lColVVS As Integer
lColVVS = VET_VS.UsedRange.Columns.Count ' finds last column
For n = 1 To lColVVS
If UCase(VET_VS.Cells(3, n).Value) Like "*ENVIRONMENTAL CONDITION*" Then ' All Caps when using "like"
EnvCondCol = Split(VET_VS.Cells(3, n).Address, "$")(1)
EnvCondColN = Range(EnvCondCol & 1).Column
Exit For
End If
Next n
This works and when I watch EnvCondCol and EnvCondColN is can see EnvCondCol = "I" and EnvCondColN = "9"
Eventually, I want to insert a new column, and this line generates a syntax error:
VET_VS.Range(Columns.(EnvCondColN)).EntireColumn.Insert
When I watch EnvCondColN, it is a number, and I have tried changing the dim to other types, such as integer
Also elsewhere, I want to copy information from a cell into another cell from within a loop. This generates a syntax error.
VET_VS.Range(Columns.(EnvCondColN + i)).Copy VET_VS.Range(Columns.(EnvCondColN + j))
If I replace EnvCondColN with a value like 5, then this works. Example: VET_VS.Range(Columns.(5)).EntireColumn.Insert
Why isn't the variable working as a column reference??
Thank you all for looking!
change
VET_VS.Range(Columns.(EnvCondColN)).EntireColumn.Insert
to
VET_VS.Columns(EnvCondColN).EntireColumn.Insert
Related
Im working on a project report for work and I'm trying to find a way to compare two lists of project codes i.e "123456" and see whether the 2nd list is missing any new values that would've been entered into the first list. The lists are thousands of records long and so far people have been doing it manually (it hurts me knowing this) so I'm trying to make it automatic.
What I have tried is using an Array with a Index(Match(CountIF))) formula but I just cant seem to get it working.
My problem is that when I get the array to fill with what i want I then can't get it to not duplicate values (I need it to check the masterlist so it doesnt output something more than once into the output list).
I've also tried to give it a go with other formulas - but the lists can be thousands of records long so I cant do a cell for cell match as the list would be huge (that or my excel knowledge isnt good enough to know the easy solution).
Any help would be hugely appreciated.
Array might not be the best solution
I've checked quite a few other solutions but they don't quite deal with my issue and I don't have the skill to adapt them.
Here is one approach using VBA and arrays which is quicker than doing via the sheet. It checks each item in H to see it is present in J (and not the other way round). I assume that's what you want.
Sub x()
Dim v1, v2, v3(), i As Long, j As Long
v1 = Range("H2", Range("H" & Rows.Count).End(xlUp)).Value
v2 = Range("J2", Range("J" & Rows.Count).End(xlUp)).Value
ReDim v3(1 To UBound(v1, 1))
For i = LBound(v1) To UBound(v1)
If IsError(Application.Match(v1(i, 1), v2, 0)) Then
j = j + 1
v3(j) = v1(i, 1)
End If
Next i
Range("K2").Resize(j) = Application.Transpose(v3)
End Sub
Using an input box
Sub x()
Dim v1, v2, v3(), i As Long, j As Long
v1 = Application.InputBox("First list", Type:=8)
v2 = Application.InputBox("Second list", Type:=8)
ReDim v3(1 To UBound(v1, 1))
For i = LBound(v1) To UBound(v1)
If IsError(Application.Match(v1(i, 1), v2, 0)) Then
j = j + 1
v3(j) = v1(i, 1)
End If
Next i
Range("K2").Resize(j) = Application.Transpose(v3)
End Sub
A formula solution.
Note that I turned the first two ranges into Tables and changed the names. The formula is using structured references. This enables the formula to auto update if you add rows in the future.
=IFERROR(INDEX(ProjList1[#Data],AGGREGATE(15,6,1/ISNA(MATCH(ProjList1[#Data],ProjList2[#Data],0))*ROW(ProjList1[#Data]),ROWS($1:1))-ROW(ProjList1[#Headers])),"")
How does it work? Briefly:
MATCH generates an array of #NA! errors or a number.
ISNA turns that into an array of TRUE/FALSE where TRUE indicates an entry in table 1 that is NOT in table 2
Multiplying that array by the array of project list rows returns an array of error message vs row number
AGGREGATE small function ignores the error returns to give an ascending list of row numbers
INDEX then returns the appropriate entry from Table 1
ROW(ProjList1[#Headers]) is a correction so that the table may be located anyplace on the worksheet, and still return the correct row.
Not sure if you're trying to set this up so it will autoupdate in future, but as a stopgap:
Countif column next to list 1 that checks whether they appear in list 2...
... Feeding into a pivot that only shows those where the countif value is 0, in the "row" field to remove duplication?
In some of my column's cells there appear #VALUE! words and formulas inside are as follows example:
=IF(VALUE(RIGHT(CELL("nome.arquivo";A1);LEN(CELL("nome.arquivo";A1))-SEARCH("]";CELL("nome.arquivo";A1))))=1;1;1+INDIRECT(ADDRESS(329;COLUMN();;;VALUE(RIGHT(CELL("nome.arquivo";A1);LEN(CELL("nome.arquivo";A1))-SEARCH("]";CELL("nome.arquivo";A1))))-1)))
Mentioned column is CT. Now when i am trying to loop through the cells when it comes to first occurence of #VALUE! i get an error:
Run Time Error 13, Type mismatch on this line:
L = 9
Do While Cells(L, "CT").Value <> "" '<========= HERE AN ERROR
L = L + 8
Loop
How to fix that?
Cells doesn't take any String parameter, the type mismatch error you're getting has nothing to do with #VALUE / the data being processed - because the code never gets to evaluate the data, since Cells wants two Integer parameters: dang this bites me everytime - apparently you can use string parameters in the Cells function. Ugh.
So the problem is with comparing the value to "" - a string. #VALUE! isn't a valid string function so you need to account for it:
Dim theCell As Range
Set theCell = Cells(L, "CT")
If Not IsError(theCell.Value) Then
Do While Not IsEmpty(theCell.Value)
'...
L = L + 8
Loop
End If
You might also want to correctly qualify that function call:
Do While Not IsEmpty(ActiveSheet.Cells(L, "CT").Value)
That way it's explicit that you're looking at a cell in the active worksheet; an unqualified call is implicitly doing that, and anything implicit is potentially confusing and bug-prone.
Make sure the top of the module says Option Explicit and that L is properly declared:
Dim L As Long
"L" being a meaningless identifier, you should consider naming it after what you're using it for:
Dim currentRow As Long
currentRow = 9
Do While Not IsEmpty(ActiveSheet.Cells(currentRow, "CT"))
That way your code becomes much easier to read, follow and understand.
I'm trying to automate certain functions in an Excel file.
Here is my issue:
Table 1 contains a string is Column "Info", followed by two empty cells. For each of the rows in Table 1, I want to check if a value of Table 2, Column "Fruit" exists in column "Info" of Table 1. If so, I would like to fill in the "Color" and "Price" of Table 2 in the empty cells in Table 1.
For example, the second row contains the word "bananas", which means "Color" "Yellow" and "Price" "15" should be filled in the same columns in Table 1, row 2.
Somehow this issue seems so simple to me, but when I start to think of how to implement this, I get stuck. So unfortunately, I don't have any code available to fix. I just hope this issue isn't too vague.
I've also tried solving this issue using formulas, using MATCH and INDEX, but I couldn't get that to work either.
Here's a function that will return the row in the ListObject (Table) where the first matching word is found.
Public Function MatchFruit(ByVal sInfo As String, ByRef rFruit As Range) As Long
Dim vaSplit As Variant
Dim i As Long, j As Long
Dim rFound As Range
Dim sWhat As String
vaSplit = Split(sInfo, Space(1))
For i = LBound(vaSplit) To UBound(vaSplit)
'strip out non-alpha characters
sWhat = vbNullString
For j = 1 To Len(vaSplit(i))
If Asc(Mid(LCase(vaSplit(i)), j, 1)) >= 97 And Asc(Mid(LCase(vaSplit(i)), j, 1)) <= 122 Then
sWhat = sWhat & Mid(vaSplit(i), j, 1)
End If
Next j
'find the word in the range
Set rFound = Nothing
Set rFound = rFruit.Find(sWhat, , xlValues, xlWhole, , , False)
If Not rFound Is Nothing Then 'if it's found
'return the row in the ListObject
MatchFruit = rFound.Row - rFruit.ListObject.HeaderRowRange.Row
'stop looking
Exit For
End If
Next i
End Function
Assuming your first table is called tblData and your second table tblFruit, you would get the color using
=INDEX(tblFruit[Color],MatchFruit([#Info],tblFruit[Fruit]))
and the price similarly
=INDEX(tblFruit[Price],MatchFruit([#Info],tblFruit[Fruit]))
Long Explanation
The vaSplit assignment line uses the Split function to convert a string into an array based on a delimiter. Since your sample data was sentences, the normal delimiter is a space to split it into words. A string like
This is some line about apples.
is converted to an array
vaSplit(1) This
vaSplit(2) is
vaSplit(3) some
vaSplit(4) line
vaSplit(5) about
vaSplit(6) apples.
Next, the For loop goes through every element in the array to see if it can find it in the other list. The functions LBound and Ubound (lower bound and upper bound) are used because we can't be sure how many elements the array will have.
The first operation inside the loop is to get rid of any extraneous characters. For that, we create the variable sWhat and set it to nothing. Then we loop through all the characters in the element to see if any are outside of the range a...z. Basically, anything that's a letter gets appended to sWhat and anything that's not (a number, a space, a period) doesn't. In the end sWhat is the same as the current element with all non-alpha characters stripped out. In this example, we'd never match apples. because of the period, so it's stripped away.
Once we have a good sWhat, we now use the Find method to see if that word exists in the rFruit range. If it does, then rFound will not be Nothing and we move ahead.
Note that if it doesn't find the word in the range, then rFound will be Nothing and the function will return zero.
If the word is found, the function returns the row it was found on less the row where the ListObject starts. That way the function returns what row it is withing the data of the ListObject not on the worksheet. This is useful when incorporating into an INDEX formula. To make a formula return something, you assign that something to the formula's name.
Finally, the Exit For line simply stops looking through the array once a match was found. If you have more than one match in your data, it will only return the first one.
Troubleshooting
The most likely error that you'll find is that the function will return zero when you expect it to return a row number. That most likely means it did not find any words in the list.
If you're certain that both lists contain a matching word, here's how you troubleshoot it: After the Set rFound = line put a Debug.Print statement.
Set rFound = rFruit.Find(sWhat, , xlValues, xlWhole, , , False)
Debug.Print "." & sWhat & "."
If Not rFound Is Nothing Then 'if it's found
That will print sWhat to the Immediate Window (Ctrl+G in the VBE to see the Immediate Window). The periods around the word are so you can see any non-printable characters (like spaces). If you try to match .pears . with pears it won't match because the first one has a space at the end - and you can see that because we stuck periods before and after.
If spaces are going to be a problem, you can use the Trim$() function on sWhat to get rid of them first.
With that Debug.Print statement, you might see results like
.paers.
in which case would recognize that you have a typo.
To Dick and other people who may be interested. Like I mentioned in my last comment on the answer provided by #Dick-Kusleika, his answer didn't fully cover my initial question. Even though it gave me great insight and it did the job of filling the empty cells with the appropriate data, I was really looking for something that would do it automatically, without me having to copy-paste any formulas. So I spent some more time trying to figure it out, getting info from the internet and sparring with a colleague who shares my interest in this. And eventually I managed to get it working! (hurray!!)
Below is my solution. As I'm still a beginner, I probably did a few things that could have been done better or cleaner. So I'm really interested in your opinion about this and would love to hear any remarks or tips.
Sub check_fruit()
Dim ws As Excel.Worksheet
Dim lo_Data As Excel.ListObject
Dim lo_Fruit As Excel.ListObject
Dim lr_Data As Excel.ListRow
Dim lr_Fruit As Excel.ListRow
Dim d_Info As Variant
Dim f_Fruit As Variant
Set ws = ThisWorkbook.Worksheets("Exercise")
Set lo_Data = ws.ListObjects("tblData")
Set lo_Fruit = ws.ListObjects("tblFruit")
For Each lr_Data In lo_Data.ListRows
'check if field "Color" is empty in tblData'
If IsEmpty(Intersect(lr_Data.Range, lo_Data.ListColumns("Color").Range).Value) Then
d_Info = Intersect(lr_Data.Range, lo_Data.ListColumns("Info").Range).Value
For Each lr_Fruit In lo_Fruit.ListRows
f_Fruit = Intersect(lr_Fruit.Range, lo_Fruit.ListColumns("Fruit").Range).Value
'check for each row in tblFruit if value for field "Fruit" exists in field "Info" of tblData'
If InStr(1, d_Info, f_Fruit, vbTextCompare) <> 0 Then
Intersect(lr_Data.Range, lo_Data.ListColumns("Color").Range).Value = Intersect(lr_Fruit.Range, lo_Fruit.ListColumns("Color").Range).Value
Intersect(lr_Data.Range, lo_Data.ListColumns("Price").Range).Value = Intersect(lr_Fruit.Range, lo_Fruit.ListColumns("Price").Range).Value
End If
Next lr_Fruit
End If
Next lr_Data
End Sub
I'm attempting to write a script to, given a list of parts and their used-on numbers, combine the used-on values for all duplicate parts and sort the resulting values. That sounded confusing so here is an image of what I'm shooting for:
Desired Result
It should be able to handle duplicates and blanks.
Through a combination of research and tinkering, I've gotten a sortWithinCell function made, but my headaches are coming from writing the script to iterate down the list of parts, combining used-on values as you go, and then upon reaching a different part number, delete all but the first row that you started from and then continue. Assume that the input parts list is already sorted by part number.
Thanks all!
-Edit 1-
I did manage to find a way to combine the data values:
Function ConcatinateAllCellValuesInRange(sourceRange As Excel.Range) As String
Dim finalValue As String
Dim cell As Excel.Range
For Each cell In sourceRange.Cells
finalValue = finalValue + "," + CStr(cell.Value)
Next cell
ConcatinateAllCellValuesInRange = Right(finalValue, Len(finalValue) - 1)
End Function
However, now the trick is still identifying the input range for this function, i.e. when the part number changes.
A possibile solution would be to create a collection which uses the Part as Key and has the Used-On values as value, so at the first occurence of Part, the KeyValue pair is added, then in an ongoing loop, if the key already exists in the collection, take the value of the key and the one from the collection, merge them together, delete the current KeyValue pair and add a new one (You can't modify a KeyValue pair of a collection, therefore delete the old one and add a new one).
If you are finished looping through your list, you can loop through the elements in the collection and save them somewhere else on the sheet. Or if you want, delete the current range and insert everything where the old values were.
Let me know if you need help with this
EDIT
Here is an example of the method I described, though i used a Dictionary instead of a Collection, because it has more functionality (REQUIRES A REFERENCE TO "Microsoft Scripting Runtime"):
Option Explicit
Sub combineStuff()
'Create Dictionary
Dim tmpDic As New Dictionary
'tempstring to preserve the value of a key
Dim tmpValue As String
Dim i As Integer
'Loop through rows - change this to your needs
For i = 1 To 15 Step 1
'Simple check if "Part" and "Used-On" are both filled
If Cells(i, 1).Value <> "" And Cells(i, 2).Value <> "" Then
'Check if the Key already exists
If tmpDic.Exists(CStr(Cells(i, 1).Value)) Then
'If it does, save it's value
tmpValue = tmpDic.Item(CStr(Cells(i, 1).Value))
'Delete the Key Value pair
tmpDic.Remove CStr(Cells(i, 1).Value)
'Add Key Value pair with updated Value
tmpDic.Add CStr(Cells(i, 1).Value), tmpValue & "," & CStr(Cells(i, 2).Value)
Else
'Key does not exist yet, add it
tmpDic.Add CStr(Cells(i, 1).Value), Cells(i, 2).Value
End If
End If
Next i
Dim tmpKey As Variant
i = 1
'Loop through all items in the Dictionary
For Each tmpKey In tmpDic
'Insert Key
Cells(i, 4).Value = tmpKey
'Insert Value
Cells(i, 5).Value = tmpDic(tmpKey)
i = i + 1
Next tmpKey
End Sub
Note that the Dictionary will not be sorted! The key that was modified last is the last one in the list. If you want the outcome to be sorted, it might be better to use a multidimensional array to store the key and value pairs. Then you can easily sort those.
I have a loop wherein I take the mean of several columns of numbers with the same number of rows each.
The point of the loop is to capture these means in a new vector.
So for each loop I need to indicate "all rows". In matlab this would be easy, just use ":" But I can't figure out what the analogy is in VB. Please help! Thanks.
(Please advise me as to what I put in the code below where I have ALLROWS).
My attempt so far:
For i = 1 To CA
mrCA11(i) = Application.WorksheetFunction.Average(revCA11(**ALLROWS**,i))
Next i
In matlab this would be:
For i = 1:CA
mrCA11(i) = mean(revCA11(:,i));
Next i
EDIT: I've also tried this trick to no avail:
For j = 1 To CA
For i = 1 To s11
temp11(i) = revCA11(i, j)
Next i
mrCA11(j) = Application.WorksheetFunction.Average(temp11)
Next j
I get the error message: "Unable to get the Average property of the Worksheet Function class"
As everybody (Tim and shahkalpesh at least) pointed out, we need to understand what is revCall or more specifically, we need to understand how you want to give them ALL ROWS in argument.
Finding the last row (or column or cell)
A common Excel issue is to find the last used row / column / cell.
This will give you the end of your vector.
Excel give you several methods to deal with this:
xlTypeLastCell
Last cell used in the entire sheet (regardless if it's used in column A or not)
lastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
End(xlUp)
Last cell used (including blanks in-between) in Column A is as simple as this:
lastRow = Range("A" & Rows.Count).End(xlUp).Row
End(xlToLeft)
Last cell used (including blanks in-between) in Row 1 is as simple as this:
lastRow = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Row
UsedRange
Last cell used in the WorkSheet (according to Excel interpretation):
Set rangeLastCell = ActiveSheet.UsedRange
Using an array as argument
The methods above told you how to find the last row (if this is what you need). You can then easily create your vector and use it in your procedure revCA11.
You can either give an array as argument as Tim pointed out in his answer with this kind of statement:
myArray = ActiveSheet.Range("A1", Cells(lastRow, lastColumn).Value
Or you can use the integer (or long) to build your vector inside your procedure as simple as declaring a range:
Range("A1:A" & lastRow)
You might clarify exactly how revCA11 is declared/created, but maybe something along these lines might work for you:
Sub Tester()
Dim arr, x
arr = ActiveSheet.Range("A1:D5").Value '2-D array
'average each column
Debug.Print "Columns:"
For x = 1 To UBound(arr, 2)
Debug.Print x, Application.Average(Application.Index(arr, 0, x))
Next x
'average each row
Debug.Print "Rows:"
For x = 1 To UBound(arr, 1)
Debug.Print x, Application.Average(Application.Index(arr, x, 0))
Next x
End Sub