Problem: I'm trying to run a match function based on a range that has variables.
Scope: The goal is to find the first instance of the word "awesome" in column A between row x and the last row; and return the row number
Case:
LastRow = Sheets("demo").Cells(Rows.Count, 1).End(xlUp).Row
For x = 2 To LastRow
Dim rng as Range
Set rng = "A" & x & ":A" & LastRow
Attempts:
"=Match("awesome","A" & x & ":A" & LastRow,0)"
"=Match("awesome",range(""A"" & x & "":A"" & LastRow),0)"
"=Match("awesome",rng,0)"
"=Match("awesome",range(rng),0)"
Nothing Works!
This code will return the row number. The lookat:=xlWhole matchs the entire cell value, lookat:=xlPart, will match any part of the cell value
firstrowmatch = Worksheets("Demo").Range("A" & x & ":A" & LRow).Find(what:="awesome", lookat:=xlWhole).Row
Related
I would like to use some macro to populate cells with the formula subtotal(9,"range"), being the range dinamic, based on the lenght of the cell.
sample
I need to populate in row "C" the formula subtotal(9;range) based on the values in column "B".
It have to check the value on column B, and compare to the row below. If the value of the row below is equal or inferior, it must be "blank", if not, will create a formula =subtotal(9,range), the range will start the row below and go until find a lenght equal or inferior.
I do this manual, but sometimes i have more than 1000 rows.
Many thanks.
In the question you mention to populate the row with the subtotal function only if current row is inferior or equal to next row, but in your sample you only populate when is inferior. So I coded it that way. It can be changed by replacing the > in If .Range("B" & next_row) > .Range("B" & r) Then to >=
Sub populate()
Dim r As Long, r2 As Long, last_row As Long
Dim next_row As Long, current_len As Long, test_len As Long
Dim rng As String
With ActiveSheet
last_row = .Cells(Rows.Count, 1).End(xlUp).Row
For r = 2 To last_row
next_row = r + 1
If .Range("B" & next_row) > .Range("B" & r) Then
current_len = .Range("B" & r)
'create range
For r2 = r + 1 To last_row
test_len = .Range("B" & r2)
If current_len >= test_len Then
rng = "C" & r + 1 & ":" & "C" & r2 - 1
Exit For
End If
Next
.Range("C" & r).Formula = "=SUBTOTAL(9," & rng & ")"
End If
Next
End With
End Sub
With those code is be able to search all the value from the A column but did have any way to filter it? like base on B,C,D column is empty or got value.
Final result will be like if B or C or D column is empty then the A column Title will list in X ,if B,C,D is got value then the A column title will list in Y.
*So the A column will return to listbox or combobox base on column B,C,D is empty or not
With Worksheets("sheet1")
Me.x.List = .Range("A1:A" & .Range("A" & .Rows.Count).End(xlUp).Row).Value
Me.y.List = .Range("A1:A" & .Range("A" & .Rows.Count).End(xlUp).Row).Value
End With
attached is the result look like:
Example 1
i solved by myself
Private Sub UserForm_Initialize()
Dim X As Long
Dim Y As Long
Dim ws As Worksheet
Set ws = Worksheets("Sht1")
Y = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
For x= 1 To Y
If ws.Range("B" & x) ="" or ws.Range("C" & x) = "" or ws.Range("D" & x) = ""Then
Me.ListBox1.AddItem ws.Range("A" & x)
End If
Next r
End Sub
So I wrote a VBA code to calculate the number of blanks, non-blanks and total entries under each header for some input data. I want to add a code that copies and pastes the values from one sheet to another, dedupes the values, gives me the unique list of values under each header, number of unique values, and the number of times those unique values are occurring under the header.
Blanks: I used the countblank function earlier, but it would skip certain empty fields, so I changed it to sumproduct(len(Range)=0)*1).
Non-Blanks: I wrote a similar function and tried to calculate the above.
It turns out VBA is unable to process the Sumproduct function. Here are the approaches I have tried:
1. Application.WorksheetFunction.Sumproduct(...)
2. ..Number.. = "=Sumproduct(...)"
3. ..Number.. = Evaluate("Sumproduct(...)")
4. ..Number.. = Worksheet.Evaluate("Sumproduct(...)")
Below is the code for the macro, I am writing the code on the Input_File, i.e., the Input worksheet.
Sub Dedupe()
ThisWorkbook.Worksheets("Control_Totals").Cells.ClearContents
Dim lRow As Long
Dim lCol As Long
Dim i As Long
Dim j As Long
Dim Input_File As Worksheet
Dim Output_File As Worksheet
Dim Dedup_File As Worksheet
Dim Col_Let As String
Dim Rng As String
Dim blank As String
Dim non_blank As String
Set Input_File = ThisWorkbook.Worksheets("Input")
Set Output_File = ThisWorkbook.Worksheets("Control_Totals")
Set Dedup_File = ThisWorkbook.Worksheets("Deduped")
With Output_File
.Cells(1, 1) = "Field_Name"
.Cells(1, 2) = "Blanks"
.Cells(1, 3) = "Non-Blanks"
.Cells(1, 4) = "Total"
End With
'Finding the last row among all entries, including the blank ones
lRow = Input_File.Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
MsgBox "Last Row: " & lRow
'Finding the last column header/field
lCol = Input_File.Cells.Find(What:="*", _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
MsgBox "Last Column: " & lCol
i = 1
'Finding the number of blank and non-blank entries for all the fields
Do While i < lCol + 1
Col_Let = ColumnLetter(i)
Rng = "Input!" & "Col_Let" & "2" & ":" & "lRow"
Output_File.Cells(i + 1, 1) = Input_File.Cells(1, i)
blank = "SumProduct((Len(Rng) = 0) * 1)"
non_blank = "SumProduct((Len(Rng) > 0) * 1)"
Output_File.Cells(i + 1, 2).Value = Evaluate(blank)
Output_File.Cells(i + 1, 3).Value = Evaluate(non_blank)
Output_File.Cells(i + 1, 4) = lRow - 1
'Deduping the data under the headers
j = 0
For j = 1 To lRow
Dedup_File.Cells(j, i).Value = Input_File.Cells(j, i).Value
j = j + 1
Next
Dedup_File.Range(Cells(1, i), Cells(lRow, i)).RemoveDuplicates Columns:=1, _
Header:=xlYes
i = i + 1
Loop
End Sub
These lines don't do what you think they do
Col_Let = ColumnLetter(i)
Rng = "Input!" & "Col_Let" & "2" & ":" & "lRow"
Rng is always a string containing "Input!Col_Let2:lRow"
What you meant was: (I think)
Rng = "Input!" & Col_Let & "2" & ":" & Col_Let & lRow
Secondly Rng exists only within this vba routine - it doesn't mean anything to Excel so you can't use it in an Excel Formula. You need
blank = "SumProduct((Len(" & Rng.address & ") = 0) * 1)"
and finally SumProduct doesn't like those sort of tricks in VBA (It relies on excel expanding the 1 into an array automatically). A better solution:
Dim cBlank as long
Dim cNonBlank as long
Dim r as range
For each r in rng
if r.text = "" then
cBlank= cBlank+1
else
cNonBlank = cNonBlank +1
end if
next r
I want to add a code that copies and pastes the values from one sheet to another, dedupes the values, gives me the unique list of values under each header, number of unique values, and the number of times those unique values are occurring under the header.
What you have just described there is a PivotTable, with the field of interest in both the Rows area and in the Values area as a Count.
I am trying to find out how to fill down (or copy?) a row (lastUsedRow) up to the last row. However I find myself struggling with designating ranges (especially because I am working on different datasets that have different sizes).
Before
I need to spot the lastUsedRow (lastUsedRow = .Range("A" & .Rows.Count).End(xlUp).Row) - which is row 31 here. It designates the latest row where there was data in column A.
Then I want to tell VBA to fill down until the last row (lastRow) - row 39 - which can be found using lastRow = .Range("E" & .Rows.Count).End(xlUp).Row. It designates the latest row where there was data in column E.
After
Question
VBA recommends to work with Range().FillDown but I struggle with designating the range when coding for changing datasets. More precisely, how to I write down a range that is between lastUsedRow and lastRow?
I think you want to fill down Columns A thru D, from the lastUsedRow (defined from Col A) to the lastRow (defined from Col M), using the values from lastUsedRow in columns A:D.
Dim lastRow as Long, lastUsedRow as Long
Dim srcRange as Range, fillRange as Range
With Worksheets("Sheet1")
lastUsedRow = .Range("A" & .Rows.Count).End(xlUp).Row
lastRow = .Range("M" & .Rows.Count).End(xlUp).Row
' Fill values from A:D all the way down to lastUsedRow
Set srcRange = .Range("A" & lastUsedRow & ":D" & lastUsedRow)
Set fillRange = .Range("A" & lastRow & ":D" & lastUsedRow)
fillRange.Value = srcRange.Value
End With
If you need to preserve formatting, then use the Copy method:
srcRange.Copy Destination:=fillRange
Note: +1 to you for using See correct way to find the 'last row'
I am trying to assign Cell E8 in Sheet"Report" with an Index Match formula with a dynamic range. The range is from Sheet"Data"
I have found the last row (LR) and last column (lc).
The run time error occurs at the last line: Cell("E8").formula = "=...."
This is the code:
Sub report()
Dim LR As Long, lc As Long, first As Long, proxy As String
Sheets("Data").Select
'Finding the first filled cell by moving down from A1
first = Sheets("Data").Range("A1").End(xlDown).Row
'The first row has column headers: Name, ID number, etc... SO I assign it to the next row where the first data entry is
first = first + 1
LR = Sheets("Data").Range("A" & first).End(xlDown).Row
lc = Sheets("Data").Range("A" & first).End(xlToRight).Column
Sheets("Report").Select
proxy = "=IFERROR(INDEX(Data!$A$10:" & Cells(LR, lc).Address & ",MATCH(Report!$C$3,Data!$A$10:" & Cells(LR, 1).Address & ",0),MATCH(Report!$C8,Data!A$9:" & Cells(9, lc).Address & ",0)),'N/A')"
Cells("E8").Formula = proxy
End Sub
Sub report()
Dim LR As Long, lc As Long, first As Long, proxy As String
With Sheets("Data")
'Finding the first filled cell by moving down from A1
first = .Range("A1").End(xlDown).Row
'The first row has column headers: Name, ID number, etc... SO I assign it to the next row where the first data entry is
first = first + 1
LR = .Range("A" & Rows.Count).End(xlUp).Row
lc = .Range("A" & first - 1).End(xlToRight).Column
End With
proxy = "=IFERROR(INDEX(Data!$A$10:" & Cells(LR, lc).Address & ",MATCH(Report!$C$3,Data!$A$10:" & Cells(LR, 1).Address & ",0),MATCH(Report!$C8,Data!A$9:" & Cells(9, lc).Address & ",0)),""N/A"")"
Sheets("Report").Range("E8").Formula = proxy
End Sub
You are using single quotes to wrap 'N/A'. You need double quotes and because they are quotes within a quoted string, you need to double them up. Additionally, the Range.Cells property does not accept the same style of cell address references that a Range object does.
proxy = "=IFERROR(INDEX(Data!$A$10:" & Cells(LR, lc).Address & _
",MATCH(Report!$C$3,Data!$A$10:" & Cells(LR, 1).Address & _
",0),MATCH(Report!$C8,Data!A$9:" & Cells(9, lc).Address & _
",0)),""N/A"")"
Sheets("Report").Select
Range("E8").Formula = proxy
Here is a quick rewrite that gets away from using Worksheet.Select¹ method and the implicit ActiveSheet property.
Sub report()
Dim lr As Long, lc As Long, first As Long, proxy As String
With Worksheets("Data")
'Finding the first filled cell by moving down from A1
first = .Range("A1").End(xlDown).Row
'The first row has column headers: Name, ID number, etc... SO I assign it to the next row where the first data entry is
first = first + 1
lr = .Range("A" & first).End(xlDown).Row
lc = .Range("A" & first).End(xlToRight).Column
End With
proxy = "=IFERROR(INDEX(Data!$A$10:" & Cells(lr, lc).Address & _
",MATCH(Report!$C$3,Data!$A$10:" & Cells(lr, 1).Address & _
",0),MATCH(Report!$C8,Data!A$9:" & Cells(9, lc).Address & _
",0)),""NA"")"
With Worksheets("Report")
.Range("E8").Formula = proxy
'alternate with .Cells as one of these
'.Cells(8, "E").Formula = proxy
'.Cells(8, 5).Formula = proxy
End With
End Sub
.¹ See How to avoid using Select in Excel VBA macros for more methods on getting away from relying on select and activate to accomplish your goals.