Im having issues with adding values to a Matrix. The first part is working fine, where i am adding values to columns 1-7 from "Example".
However, i have another sheet from which i want to lookup values for Matrix's column 8. The value I want can be found if i can lookup the Example(i,3), which is stored in the Matrix. How do I search a another range for the value that is stored in the Matrix?
Currently im getting the object not defined error on row: "Set cl = ExampleSet2(i, 10).Find(Example(i, 3), LookIn:=xlValues)"
ReDim Matrix(1 To x, 1 To 8)
x = 0
For i = LBound(Example) To UBound(Example)
If CStr(Example(i, DDKolumn)) = DDKey Then
x = x + 1
Matrix(x, 1) = Example(i, 8) & " | " & Example(i, 2)
Matrix(x, 2) = Example(i, 1)
Matrix(x, 3) = Example(i, 3)
Matrix(x, 4) = Example(i, 4)
Matrix(x, 5) = Example(i, 5)
Matrix(x, 6) = Example(i, 6)
Matrix(x, 7) = Example(i, 7)
For y = LBound(ExampleSet2) To UBound(ExampleSet2)
With Sheet14
Set cl = ExampleSet2(i, 10).Find(Example(i, 3), LookIn:=xlValues)
If Not cl Is Nothing Then
Matrix(x, 8) = ExampleSet2(y, 11)
End If
End With
Next y
End If
Next i
.Find is a method of a Range object. ExampleSet is a Variant array, not a Range.
ExampleSet2 = Sheets("Example").Range("A20:I" & Variable) '<~ this is not a Range object
I honestly don't see why you need an array, or even a loop. Just use a Range, and make sure to Set.
Dim ExampleSet2 as Range
Set ExampleSet2 = Sheets("Example").Range("A20:I" & Variable)
Now you can .Find on ExampleSet2 or on a subset of it.
Related
can someone please look into my code and say me where is the mistake cause I got a type mismatch error message ? With this code I would like to delete all rows who which contain "0" in the respective cells.
I got the error message for the line where is standing: sn = Application.Index(sn, Application.Transpose(Split(Mid(c00, 2), "|")), [transpose(row(1:8))])
Also I had to declare the variable "c00" and I choosed "c00 As Variant". I don't know if it its correct. I would appreciate someone helping me to solve the problem.
Dim sn As Variant, c00 As Variant
sn = Sheets(1).UsedRange
For j = 1 To UBound(sn)
If sn(j, 4) & sn(j, 5) & sn(j, 6) & sn(j, 7) & sn(j, 8) & sn(j, 9) = "000000" Then c00 = c00 & "|" & j
Next
If c00 <> "" Then
sn = Application.Index(sn, Application.Transpose(Split(Mid(c00, 2), "|")), [transpose(row(1:8))])
Sheets(1).UsedRange.ClearContents
Sheets(1).Cells(1).Resize(UBound(sn), UBound(sn, 2)) = sn
End If
Original Code
Dim LR%
LR = Cells(Rows.Count, 3).End(xlUp).Row
Set Myrange = Range("D2:AO" & LR).SpecialCells(xlCellTypeBlanks) 'nur Leerzellen
Myrange.Formula = "0"
ActiveSheet.UsedRange
Set r = ActiveSheet.UsedRange
lastrow3 = r.Rows.Count + r.Row - 1
For j = lastrow3 To 1 Step -1
If (Cells(j, 4) = 0 And Cells(j, 5) = 0 And Cells(j, 6) = 0 And Cells(j, 7) = 0 And Cells(j, 8) = 0 And Cells(j, 9) = 0) Then
Rows(j).Delete
End If
Next j
Image w/ Error
Edit: the error was from attempting to use Application.Index on an array larger than the function size limit. Redirect to here for Q&A an on alternative option to Application.Index.
I'll break down my analysis of your code:
Application.Index(Array, Row_Number, Column_Number)
The code you currently have:
sn = Application.Index(sn, Application.Transpose(Split(Mid(c00, 2), "|")), [transpose(row(1:8))])
is saying that the parameters are:
Array: sn
Row_Number: Application.Transpose(Split(Mid(c00, 2), "|"))
Column_Number: [transpose(row(1:8))]
The Array section looks fine to me. The Row numbers will, I think(?), be the values for j which you collected in c00 (although the Application.Transpose may not be necessary Correction: it is in this scenario.). I have no idea what is going on with your Column_Number parameter....
Issues:
Application.Index keeps the selected columns/rows. However, your if statement selects the values of j where the rows are entirely 0, so instead of losing them, you would be keeping only those rows.
If your intention is to keep all the columns, you can just input 0 into the Column_Number parameter. Correction: this works when only selecting a single row to keep. If selecting multiple rows, all columns must be listed as well.
Corrected code:
Since this code does delete data, you should save a copy of the data before running this code on it.
Note: c00 can be a Variant; String also works. You will need to also copy over the fillA function, as well.
Dim sn As Variant, c00 As String
sn = Sheets(1).UsedRange
' Changed condition based on your post with previous code. (And negated)
For j = 1 To UBound(sn)
If Not ((Cells(j, 4) = 0 And Cells(j, 5) = 0 And Cells(j, 6) = 0 And Cells(j, 7) = 0 And Cells(j, 8) = 0 And Cells(j, 9) = 0)) Then c00 = c00 & "|" & j
Next
If c00 <> "" Then
' Corrected inputs for Application.Index, Added helper function "fillA".
sn = Application.Index(sn, Application.Transpose(Split(Mid(c00, 2), "|")), fillA(1, UBound(sn, 2) - LBound(sn, 2) + 1))
Sheets(1).UsedRange.ClearContents
Sheets(1).Cells(1).Resize(UBound(sn), UBound(sn, 2)) = sn
End If
Function fillA(min As Long, max As Long) As Variant
Dim var() As Variant, i As Long
ReDim var(1 To max - min + 1)
For i = min To max
var(i) = i + min - 1
Next i
fillA = var
End Function
Edit:
Realized this did not address your issue. I suspect that the error was from the [transpose(row(1:8))] you were inserting for the Column_Number parameter.
Maybe someone else has a simpler way of doing what I did with the fillA function (what I believe you were attempting).
I wanna ask related to excel vba.
I'm trying to consolidate data from worksheet, containing data like screenshot(1).
What i'm want to do is to consolidate data with unique row is in row H (CTP.GRP) and sum column M(Nominal) populate to another sheet in column utlization & column P(Mtm in IDR) Popullate data to another sheet column market value
My code only sum one column, anyone can help with code how to sum two column?
Sub ins_data()
Dim x As Variant
Dim y As Variant
Dim countDict As Variant
Dim a As Long
Set countDict = CreateObject("Scripting.Dictionary")
x = Sheets("Data").Range("A2").CurrentRegion
ReDim y(1 To UBound(x, 1), 1 To UBound(x, 2))
For a = 2 To UBound(x, 1)
cat1 = x(a, 8)
val1 = x(a, 16)
If countDict.exists(cat1) Then
countDict(cat1) = countDict(cat1) + val1
Else
countDict(cat1) = val1
End If
Next a
i = 1
For Each d In countDict
y(i, 2) = d
y(i, 8) = countDict(d)
i = i + 1
Next d
ThisWorkbook.Sheets("X").Range("B5").Resize(UBound(y), UBound(y, 2)).Value = y
Expected result:
Edited after OP’s further clarification
you could use this code:
Option Explicit
Sub ins_data()
Dim countDict As Object, countDict2 As Object
Set countDict = CreateObject("Scripting.Dictionary")
Set countDict2 = CreateObject("Scripting.Dictionary")
Dim x() As Variant
x = Sheets("Data").Range("A2").CurrentRegion.Value2
Dim a As Long
For a = 2 To UBound(x, 1)
countDict(x(a, 8)) = countDict(x(a, 8)) + x(a, 13)
countDict2(x(a, 8)) = countDict(x(a, 8)) + x(a, 16)
Next
With ThisWorkbook.Sheets("X").Range("B5").Resize(countDict.Count) ‘ change “B5” to the actual worksheet “X” cell you want to start writing Sheets("Data")) column H unique values from
.Value = Application.Transpose(countDict.Keys)
.Offset(, 6).Value = Application.Transpose(countDict.Items) ‘ change “6” to your actual column offset from Sheets("X") referenced column (currently, “B”) you want to start writing Sheets("Data")) column M consolidated sum from
.Offset(, 7).Value = Application.Transpose(countDict2.Items) ‘ change “7” to your actual column offset from Sheets("X") referenced column (currently, “B”) you want to start writing Sheets("Data")) column P consolidated sum from
End With
End Sub
I am trying to use the below to run through values in Column A on a Sheet Named "Report" and Create these ranges in a Sheet called "Holidays_Requested" but everytime I it pops up with
Object Required Runtime error 424.
Can anyone help or know of an alternative way of creating named ranges using VBA.
Sub TransposeRange_new_code()
Dim OutRange As Range
Dim x As Long, y As Long
Dim sKey As String
Dim maxCount As Long
Dim data, dic, keys, items, dataout()
Application.ScreenUpdating = False
data = Sheets("Report").Range("A2:E" & Report.Cells(Report.Rows.Count, "A").End(xlUp).Row).Value2
Set dic = CreateObject("scripting.dictionary")
Set OutRange = Sheets("Holidays_Requested").Range("B2")
For x = 1 To UBound(data, 1)
If Trim$(data(x, 1)) <> "_" Then
sKey = Trim$(data(x, 1)) & Chr(0) & Trim$(data(x, 2))
If Not dic.exists(sKey) Then dic.Add sKey, CreateObject("Scripting.Dictionary")
dic(sKey).Add x, Array(data(x, 4), data(x, 5))
If dic(sKey).Count > maxCount Then maxCount = dic(sKey).Count
End If
Next
ReDim dataout(1 To maxCount + 1, 1 To dic.Count * 3)
keys = dic.keys
items = dic.items
For x = LBound(keys) To UBound(keys)
dataout(1, x * 3 + 1) = Split(keys(x), Chr(0))(0)
dataout(1, x * 3 + 2) = Split(keys(x), Chr(0))(1)
For y = 1 To items(x).Count
dataout(1 + y, x * 3 + 1) = items(x).items()(y - 1)(0)
dataout(1 + y, x * 3 + 2) = items(x).items()(y - 1)(1)
Next y
Next
OutRange.Resize(UBound(dataout, 1), UBound(dataout, 2)).Value2 = dataout
For x = 1 To UBound(keys)
OutRange.Offset(0, (x - 1) * 3).Resize(maxCount, 2).Name = "" & validName(Split(keys(x - 1), Chr(0))(0))
With OutRange.Offset(0, (x - 1) * 3 + 1)
.Hyperlinks.Add anchor:=.Cells(1), Address:="mailto://" & .Value2, TextToDisplay:=.Value2
End With
Next
End Sub
In your code, you're referring to a non-instantiated variable Report. Since this variable hasn't been declared with a Dim statement, it will be treated as an empty variant, zero-length string, or 0-value numeric, or a Nothing object, depending on how/when you call upon it.
And since you're doing Report.__something__ the compiler assumes it's supposed to be an Object (since only Object type have properties/methods). Since it doesn't exist and/or hasn't been assigned, you're doing essentially: Nothing.Cells...
This will always raise a 424 because in order to invoke any .__something__ call, you need to invoke it against a valid, existing Object.
Change:
data = Sheets("Report").Range("A2:E" & Report.Cells(Report.Rows.Count, "A").End(xlUp).Row).Value2
To:
With Sheets("Report")
data = .Range("A2:E" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value2
End With
As always, using Option Explicit in each module will prevent you from executing/running code with undeclared variables. I would recommend adding that statement at the top of each code module, and then rectifying any compile errors (such as Variable undefined) which might arise.
Also: See here for more reliable ways of finding the "last" cell in a given range.
And here is a VB.NET (similar conceptually) explanation of why you should be using Option Explicit.
I have two rows of data, fracture pressure and depth. I have to code in vba to generate the polynomial (quadratic for this case) equation and then output the coefficients to the worksheet. I am using Linest and Index. For this two rows of data, I don't know how many datasets I have because I need to delete some noisy data first (the definition of noisy data is randomly so the number of datasets vary each time), so I can't use something like "A17:A80" in the linest function. However, it looks like the worksheet function in vba can't work for arrays.
Dim Frac_x, Frac_y As Range
Dim X
Set Frac_x = Range(Cells(17, 1), Cells(e - 1, 1))
Set Frac_y = Range(Cells(17, 7), Cells(e - 1, 7))
X= Application.WorksheetFunction.LinEst(Frac_y,Frac_x,{1,2})
Cells(3, 8).Value = Application.WorksheetFunction.Index(X, 1, 1)
Cells(4, 8).Value = Application.WorksheetFunction.Index(X, 1, 2)
Cells(5, 8).Value = Application.WorksheetFunction.Index(X, 1, 3)
In this code, e is defined in the previous code, (e-1) represents the total number of datasets. However, I keep getting { is a invalid character for the line: X= Application.WorksheetFunction.LinEst(Frac_y,Frac_x,{1,2})
Then I did some researches and modified the code to:
Dim Frac_x, Frac_y As Range
Dim X
Set Frac_x = Range(Cells(17, 1), Cells(e - 1, 1))
Set Frac_y = Range(Cells(17, 7), Cells(e - 1, 7))
X = Application.Evaluate("=linest(" & Frac_y & "," & Frac_x & "^ {1,2}))")
Cells(3, 8).Value = Application.WorksheetFunction.Index(X, 1, 1)
Cells(4, 8).Value = Application.WorksheetFunction.Index(X, 1, 2)
Cells(5, 8).Value = Application.WorksheetFunction.Index(X, 1, 3)
Then I keep getting Type Dismatch error for the line:
X = Application.Evaluate("=linest(" & Frac_y & "," & Frac_x & "^ {1,2}))")
I am sure the two ranges frac_y and frac_x their type matches. Anyone could help?
You are right, that Excel VBA can't do things like arrVariable^{1,2}. That must be done with loops over the array items.
But the Evaluate approach should work. But your formula string is not correct. To detect and avoid such incorrectness, I will ever concatenate such formula strings within a String variable first. Then I can simply check the variable's value.
Example, Values are in A17:A26 and G17:G26:
Sub test()
Dim Frac_x As Range, Frac_y As Range
Dim X
e = 27
With ActiveSheet
Set Frac_x = .Range(.Cells(17, 1), .Cells(e - 1, 1))
Set Frac_y = .Range(.Cells(17, 7), .Cells(e - 1, 7))
arrX = Frac_x
ReDim arrX2(1 To UBound(arrX), 1 To 2) As Double
For i = LBound(arrX) To UBound(arrX)
arrX2(i, 1) = arrX(i, 1)
arrX2(i, 2) = arrX(i, 1) * arrX(i, 1)
Next
X = Application.LinEst(Frac_y, arrX2)
'sFormula = "=LINEST(" & Frac_y.Address & "," & Frac_x.Address & "^{1,2})"
'X = Application.Evaluate(sFormula)
.Range(.Cells(3, 8), .Cells(5, 8)).Value = Application.Transpose(X)
End With
End Sub
Hints: Use Application.LinEst instead of Application.WorksheetFunction.LinEst. The latter will throw an error if the function cannot work while the first will return an error value instead. So the first will not interrupt the program as the latter will do.
I'm trying to figure out a way to combine rows based on values in two specific columns in vba excel.
For Example:
Let's say I have the following sheet:
Column A Column J Column Z
1 A ?
1 A !
2 B ?
2 B !
And I need to convert it to this:
Column A Column J Column Z
1 A ?, !
2 B ?, !
Here's another method using User Defined Types and collections to iterate through the list and develop the combined results. For large sets of data, it should be considerably faster than reading through each cell on the worksheet.
I assume that you are grouping on Col J, and that Column A data does not need to be concatenated in the cell. If it does, the modifications to the routine would be trivial.
First, Insert a Class Module, rename it CombData and insert the following code into that module:
Option Explicit
Private pColA As String
Private pColJ As String
Private pColZConcat As String
Public Property Get ColA() As String
ColA = pColA
End Property
Public Property Let ColA(Value As String)
pColA = Value
End Property
Public Property Get ColJ() As String
ColJ = pColJ
End Property
Public Property Let ColJ(Value As String)
pColJ = Value
End Property
Public Property Get ColZConcat() As String
ColZConcat = pColZConcat
End Property
Public Property Let ColZConcat(Value As String)
pColZConcat = Value
End Property
Then Insert a Regular Module and insert the Code Below:
Option Explicit
Sub CombineData()
Dim cCombData As CombData
Dim colCombData As Collection
Dim V As Variant
Dim vRes() As Variant 'Results Array
Dim rRes As Range 'Location of results
Dim I As Long
'read source data into array
V = Range("A1", Cells(Rows.Count, "A").End(xlUp)).Resize(columnsize:=26)
'Set results range. Here it is set below the Source Data
'Could be anyplace, even on a different worksheet; or could overlay the
' original. Area below and to right is cleared
Set rRes = Range("A1").Offset(UBound(V) + 10)
Range(rRes, rRes.SpecialCells(xlCellTypeLastCell)).Clear
Set colCombData = New Collection
On Error Resume Next
For I = 1 To UBound(V)
Set cCombData = New CombData
cCombData.ColA = V(I, 1)
cCombData.ColJ = V(I, 10)
cCombData.ColZConcat = V(I, 26)
colCombData.Add cCombData, CStr(cCombData.ColJ)
If Err.Number <> 0 Then
Err.Clear
With colCombData(cCombData.ColJ)
.ColZConcat = .ColZConcat & ", " & V(I, 26)
End With
End If
Next I
On Error GoTo 0
ReDim vRes(1 To colCombData.Count, 1 To 26)
For I = 1 To UBound(vRes)
With colCombData(I)
vRes(I, 1) = .ColA
vRes(I, 10) = .ColJ
vRes(I, 26) = .ColZConcat
End With
Next I
rRes.Resize(UBound(vRes, 1), UBound(vRes, 2)) = vRes
End Sub
EDIT: Note that the source data is read into the Variant array V. If you examine V in the Watch Window, you will see that the first dimension represents the rows; and the second dimension the columns. So if you wanted, for example, to perform the same procedure on a different set of columns, you would merely change the references to the second dimension under the line that reads Set cCombData = New CombData. For example, column B data would be V(I,2), and so forth. Of course, you might want to rename the data types to make them more representative of what you are doing.
In addition, if your data starts at row 2, merely start the iteration through V with I = 2 instead of I = 1.
EDIT2: In order to both overwrite the original, and also maintain the contents of the columns not being processed, the following modification will do that for Columns A, J and Z. You should be able to modify it for whatever columns you choose to process.
Option Explicit
Sub CombineData()
Dim cCombData As CombData
Dim colCombData As Collection
Dim V As Variant
Dim vRes() As Variant 'Results Array
Dim rRes As Range 'Location of results
Dim I As Long, J As Long, K As Long
'read source data into array
V = Range("A1", Cells(Rows.Count, "A").End(xlUp)).Resize(columnsize:=26)
'Set results range. Here it is set below the Source Data
'Could be anyplace, even on a different worksheet; or could overlay the
' original. Area below and to right is cleared
Set rRes = Range("A1") '.Offset(UBound(V) + 10)
Range(rRes, rRes.SpecialCells(xlCellTypeLastCell)).Clear
Set colCombData = New Collection
On Error Resume Next
For I = 1 To UBound(V)
Set cCombData = New CombData
cCombData.ColA = V(I, 1)
cCombData.ColJ = V(I, 10)
cCombData.ColZConcat = V(I, 26)
colCombData.Add cCombData, CStr(cCombData.ColJ)
If Err.Number <> 0 Then
Err.Clear
With colCombData(cCombData.ColJ)
.ColZConcat = .ColZConcat & ", " & V(I, 26)
End With
End If
Next I
On Error GoTo 0
ReDim vRes(1 To colCombData.Count, 1 To 26)
For I = 1 To UBound(vRes)
With colCombData(I)
vRes(I, 1) = .ColA
vRes(I, 10) = .ColJ
vRes(I, 26) = .ColZConcat
'Note the 10 below is the column we are summarizing by
J = WorksheetFunction.Match(.ColJ, WorksheetFunction.Index(V, 0, 10), 0)
For K = 1 To 26
Select Case K 'Decide which columns to copy over
Case 2 To 9, 11 To 25
vRes(I, K) = V(J, K)
End Select
Next K
End With
Next I
rRes.Resize(UBound(vRes, 1), UBound(vRes, 2)) = vRes
End Sub
This is assuming that Column J is the key and Column A doesn't need to be appended. If Column A needs to be combined as well (not always the same), you would simply need to add another for each loop to check if the data is there, and add it if not, as done for col 26 in the code.
Sub CombineData()
x = 2
Do Until Cells(x, 1) = "" 'loop through every row in sheet starting at 2 (1 will never be removed, since it is the first data)
x2 = 1
Do Until x2 = x
If Cells(x, 10) = Cells(x2, 10) Then 'this is comparing column J. If another column is the reference then change 10 to the column number
splt = Split(Cells(x, 26), ", ")
For Each s In splt 'check to see if data already in column z
If s = Cells(x2, 26) Then GoTo alreadyEntered
Next
Cells(x, 26) = Cells(x, 26) & ", " & Cells(x2, 26) 'append column z data to row x
alreadyEntered:
Rows(x2).Delete Shift:=xlUp 'delete duplicate row
x = x - 1 'to keep x at same row, since we just removed a row
Exit Do
Else
x2 = x2 + 1
End If
Loop
x = x + 1
Loop
End Sub