I'm trying to convert an Excel formula into VBA and I'm having some difficulties with the Offset conversion. The formula is being used to perform a VLookup on filtered data.
The Excel formula is:
=VLOOKUP(G4 & "",IF(SUBTOTAL(3,OFFSET(D2:D36419,ROW(D2:D36419)-ROW(D2),0,1))>0,D2:E36419),2,0)
My current VBA code is:
count = Application.WorksheetFunction.VLookup(key & "", _
IIf(Application.WorksheetFunction.Subtotal(3, _
ws.Range("D2:D36419").Offset(ws.Range("D2:D36419").Row - ws.Range("D2").Row, 0)) > 0, ws.Range("D2:E36419"), 0), 2, 0)
I need some way to include the Offset height parameter (1). Any ideas?
Note: I've tried
count = Application.WorksheetFunction.VLookup(key & "", _
IIf(Application.WorksheetFunction.Subtotal(3, _
ws.Range("D2:D36419").Offset(ws.Range("D2:D36419").Row - ws.Range("D2").Row, 0).Resize(1)) > 0, ws.Range("D2:E36419"), 0), 2, 0)
without success.
Try something like this:
Public Sub Test()
Dim SearchRange As Range
Dim FindValue As Range
Dim ReturnValue As Range
With ThisWorkbook.Worksheets("Sheet1")
'Note: I've set this one row above your search range so D2 is first cell that's looked at.
Set SearchRange = .Range("D1:D36419").SpecialCells(xlCellTypeVisible)
Set FindValue = SearchRange.Find(What:=.Range("G4"), After:=SearchRange.Cells(1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext)
If Not FindValue Is Nothing Then
Set ReturnValue = FindValue.Offset(, 1)
MsgBox ReturnValue & " found in " & ReturnValue.Address, vbOKOnly + vbInformation
Else
MsgBox "Nothing found.", vbOKOnly + vbInformation
End If
End With
End Sub
I sometimes find it hard finding the 'correct' VBA alternative to some of the Excel functions. And resort to this technique range("C1").value="=A1+B1" where you put the Excel formula in speech marks.
Sometimes I would need to know the value of A1+B1 for an if statement, but wouldn't need the total of A1+B1 being displayed. So I may do Range("AAA1481").value = "=A1+B1". It is unlikely AAA1481 will have any actual data in it. It should be out of sight and mind.
And then run a if statement such as -
If Range("AAA1481").value > 1000 then
msgbox ("above 1000")
end if
Range("AAA1481").clearcontents
Finding the correct VBA way of writing A1+B1 probably isn't too hard but I find my technique is a godsend when dealing with messy formulas like -
=SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(MAX(NUMBERVALUE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(A:A,"L",".4"),"M",".3"),"S",".2"),"R",".1"))),".4","L"),".3","M"),".2","S"),".1","R")
Related
I have a function to find a column header, but it searches from left to right. I need to find the right most column that matches, so I'd like to search right to left, but I can't figure out how. I tried using xlprevious/xlnext but they gave me the same answer.
Example:
Dim HeaderColFoundRng As Range
Set HeaderColFoundRng = Range("A1:H1").Find("FindStr", , xlValues, xlPart)
Using xlPrevious does seem to work for me:
Set HeaderColFoundRng = Range("A1:H1").Find(What:="FindStr", LookIn:=xlValues, _
LookAt:=xlPart, SearchDirection:=xlPrevious)
My guess as to why it didn't work for you is that you perhaps mixed up the argument positions. Using named arguments seems cleaner and easier to read here.
Alternative via worksheet function Filter()
If you dispose of the dynamic Excel function Filter (vs. MS/Excel 365) you can use the following steps:
a) construct a formula pattern returning column numbers (base formula e.g. =FILTER(COLUMN(A1:H1),LEFT(A1:H1,8)="forecast")),
b) evaluate the formula to get 1-based array elements with all found column numbers. - The function returns the most right occurrence (Right2Left) of the searched caption (within each string starting with the passed caption characters) which will be located via Ubound().
Further hints:
The search caption argument is Case insensitive. The Right to left direction can be changed via optional argument Right2Left = False.
Function HeaderCol(rng As Range, Caption As String, _
Optional Right2Left As Boolean = True) As Long
'a) construct formula
Dim addr As String
addr = rng.Address(False, False, external:=True)
Dim n As Long
n = Len(Caption)
Dim myFormula As String
myFormula = "=Filter(column(" & addr & "),Left(" & addr & "," & n & ")=""" & Caption & """)"
'b) get most right occurrence of evaluated formula (if Right2Left)
Dim chk
chk = Evaluate(myFormula)
If IsError(chk) Then Exit Function
HeaderCol = chk(IIf(Right2Left, UBound(chk), 1))
End Function
Possible Example call
Assuming a header row with changing column captions like "Forecast2020", "Forecast2021", "Sales2020", "Sales2021" you might want to get the last occurrence of Forecast data, i.e. the column number of "Forecast2021":
Sub testHeaderCol()
Dim col As Long
col = HeaderCol(Sheet1.Range("A1:H1"), "Forecast")
If col Then
Debug.Print "Found cell: " & Sheet1.Cells(1, col).Address(False, False, external:=True)
'do other stuff, e.g. set range object
'...
Else
Debug.Print "Nothing found!"
End If
End Sub
I am very new to Excel, VBA, Macro. My macro was working fine because I gave a simple formula, for example, D2(column name)-C2(column name) = Total time in HH:MM format new column. But I notice for some output is just #### not sure what is wrong. 1).Column)).Formula = _
"=" & cl.Offset(1, 0).Address(0, 0) & "-" & .Cells(2, col1).Address(0, 0)
cl.Offset(, 1).EntireColumn.NumberFormat = "[hh]:mm"
The issue occurs because your date in J is earier than in I and therefore the result is negative. You can use the ABS() function to get the absolute difference as positive value.
Therefore adjust your formula as below:
.Formula = "=ABS(" & cl.Offset(1, 0).Address(0, 0) & "-" & .Cells(2, col1).Address(0, 0) & ")"
You have an incorrect formula in this line:
.Range(cl.Offset(1, 1), .Cells(lastR, cl.Offset(1, 1).Column)).Formula = _
"=" & cl.Offset(1, 0).Address(0, 0) & "-" & .Cells(**2**, col1).Address(0, 0)
Why .Cells(2, col1)? This is always giving you row2 of column 1.
Also, after this line:
If cl.Value = "Full Out Gate at Inland or Interim Point (Destination)_recvd"
Then
Add:
If cl.Offset(0,1).Value = "Response Time" Then Exit For
This will keep you from inserting a new column every time you run the macro.
Try using clear variable names and consistent method for referring to rows and columns.
actCol = col1
recvdCol = cl.Column
responseCol = cl.offset(0,1).Column
.Range(lastR, responseCol).Formula = _
"= Abs(" & .Cells(lastR, recvdCol) & "-" & .Cells(lastR, actCol).Address(0, 0) & ")"
I would use a simpler approach. Highlight the entire table, and click "Format as Table", and be sure to check off "My table has headers." This will give you a named range (default name is Table1, but you can change it). Then, in the Response Time column, simply enter your formula on the first row of the table, but use your mouse to select the cells instead of typing in a cell name like "I2". You will find that the resulting formula includes something like =[#actl]-[#recvd], except that the actl and recvd will be replaced by your actual column names. And, the formula will apply to every row of the table. If you add a new row, the formula will automatically appear in that row. No code needed.
If you have a reason to use code instead of a Table (named ranges), then I would recommend (1) this code be placed directly in the "Main" worksheet module and (2) use use the "Worksheet_Changed" procedure. Microsoft Excel VBA Reference. In this case, any time the
Private Sub Worksheet_Change(ByVal Target As Range)
'Note, Target is the Range of the cell(s) that just changed.
If Intersect(Target, Range("A1:A10")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
If ActiveSheet.Cells(1, Target.Column) = "Full Out Gate at Inland or Interim Point (Destination)_actual" Then
' Cell in actual column was modified. Let's set the formula in the Response Time column:
On Error Goto EH
Application.EnableEvents = False
' Add your code here. You'll need to modify it somewhat to accommodate this methodology.
Application.EnableEvents = True
End If
EH:
Application.EnableEvents = True
Err.Raise ' expand this to whatever error you wish to raise
End Sub
Err.Raise help
I have a large amount of data (approx 60 columns and 60,000 rows) formatted as a table in Excel. I'm looking to use a macro to replace all the values greater than 1 which reside in a column titled 'Salary' in the table with a value of '2'. the table is dynamic so I need to reference the replace to the Tables column name rather than a column range like D:D.
Update:
I have put together the following code but cannot get it to work when i use What:=">0" however it will work if what="5". What am I doing wrong?
Sub FindReplace3()
ActiveSheet.ListObjects("Table1").ListColumns(61).DataBodyRange.Replace _
What:=">0", replacement:="7", _
SearchOrder:=xlByColumns, MatchCase:=True
End Sub
Evaluate can be used to replace all at once :
[Table1[Salary]] = [if(Table1[Salary] > 1, 2, Table1[Salary])]
I see this is your first post on Stackoverflow, so, welcome.
I also see you have been marked down for your question which can be disheartening as a first introduction the the site.
On SO there is an expectation that you will have researched and tried a number of things first and posted that information with the question.
You are very close, but your code is failing because you are searching for a literal string ">0" (What:=">0"). >0 obviously does not exist as a literal string.
The built in replace function limits the find to a literal string. Therefore I would use this approach:
Sub replaceTest()
Dim dblCnt As Double
dblCnt = 0
With ThisWorkbook.Worksheets("Sheet1")
For i = 1 To Range("Table1").Rows.Count
If Range("Table1[Salary]")(i) > 1 Then
Range("Table1[Salary]")(i) = "2"
dblCnt = dblCnt + 1
End If
Next i
End With
MsgBox "Finished replacing " & CStr(dblCnt) & " items", vbOKOnly, "Complete"
End Sub
FYI, your code sample was referencing Column 61, but you said the column was called 'Salary'. You can reference the column name by changing your sample from:
ActiveSheet.ListObjects("Table1").ListColumns(61).DataBodyRange.Replace _
to
ActiveSheet.ListObjects("Table1").ListColumns("Salary").DataBodyRange.Replace _
I have added another code section below and credit must go to #Slai His approach using the 'Evaluate' function is instantaneous compared to my original answer:
Sub replaceTest001()
Dim StartTime As Date
StartTime = Now()
Dim dblCnt As Double
dblCnt = 0
Application.ScreenUpdating = False
With ThisWorkbook.Worksheets("Sheet1")
[Table1[Salary]] = [if(Table1[Salary] > 1, 2, Table1[Salary])]
End With
Application.ScreenUpdating = True
MsgBox "Finished updating " & CStr(dblCnt) & " items" & vbCrLf & _
"Time taken: " & Format((Now() - StartTime), "hh:mm:ss"), vbOKOnly, "Complete"
End Sub
In Excel VBA when using the Range.Find method the output is the address of the found cell relative to the sheet (ie: SomeSheet.Range("C3")). Is there a way to return the position of the found cell within the range being searched? (ie: SearchedRange.Cells(2,4))
I am presently handling this with the snippet below but was wondering if there is a built in method or property that will handle this.
RowInRange = SomeRange.Find("foo").Row - (SomeRange.Row - 1)
As mentioned in comments, this is just simple maths to get the answer:
Sub Test()
Dim SearchedRange As Range
Dim FoundRange As Range
Dim RelativeRangeAddress As String
Range("E15").Value = "ABC" ' Dummy some data
Set SearchedRange = Range("D5:G123") ' Dummy search area
Set FoundRange = SearchedRange.Find(What:="ABC")
'Find address relative to start of search range
RelativeRangeAddress = FoundRange.Offset(1 - SearchedRange.Row, _
1 - SearchedRange.Column).Address
MsgBox RelativeRangeAddress & " is " & _
SearchedRange.Range(RelativeRangeAddress).Value ' will display "$B$11 is ABC"
'To just find the row and column (which is probably easier)
MsgBox "Relative row is " & FoundRange.Row - SearchedRange.Row + 1
MsgBox "Relative column is " & FoundRange.Column - SearchedRange.Column + 1
End Sub
I want to update the contents of a cell in a workbook. My code looks a little like this:
ProductionWorkBook.Sheets("Production Schedule").Cells(StartRow, 1).Value = EstJobName(i)
The cells are referenced using Cells(StartRow, 1) Where StartRow was a pre-declared and pre-defined integer variable that specifies the row and "1" denotes the column.
EDIT:
Now, I want to change this code to reference the columns by the column HEADERS instead.
For example, the header of a column is: "Fab Hours Date", how do I reference that?
Yes, you can simply use the letter name for the column in quotes:
Cells(StartRow, "A")
Edited to answer your further question:
to look for a specific column name, try this:
columnNamesRow = 1 ' or whichever row your names are in
nameToSearch = "Fab Hours" ' or whatever name you want to search for
columnToUse = 0
lastUsedColumn = Worksheets("Foo").Cells(1, Worksheets("Foo").Columns.Count).End(xlToLeft).Column
For col = 1 To lastUsedColumn
If Worksheets("Foo").Cells(columnNamesRow, col).Value = nameToSearch Then
columnToUse = col
End If
Next col
If columnToUse > 0 Then
' found the column you wanted, do your thing here using "columnToUse" as the column index
End If
Here are two different functions to get what you want. To use them, you'd have to put them in your code.
Function ColumnNumberByHeader(text As String, Optional headerRange As Range) As Long
Dim foundRange As Range
If (headerRange Is Nothing) Then
Set headerRange = Range("1:1")
End If
Set foundRange = headerRange.Find(text)
If (foundRange Is Nothing) Then
MsgBox "Could not find column that matches header: " & text, vbCritical, "Header Not Found"
ColumnNumberByHeader = 0
Else
ColumnNumberByHeader = foundRange.Column
End If
End Function
Function ColumnNumberByHeader2(text As String, Optional headerRange As Range) As Long
If (headerRange Is Nothing) Then
Set headerRange = Range("1:1")
End If
On Error Resume Next
ColumnNumberByHeader2 = WorksheetFunction.Match(text, headerRange, False)
If Err.Number <> 0 Then
MsgBox "Could not find column that matches header: " & text, vbCritical, "Header Not Found"
ColumnNumberByHeader2 = 0
End If
On Error GoTo 0
End Function
Example Calls:
ColumnNumberByHeader ("Extn")
ColumnNumberByHeader("1718", Range("2:2"))
Or in your case:
ProductionWorkBook.Sheets("Production Schedule"). _
Cells(StartRow, ColumnNumberByHeader("Fab Hours Date")).Value = EstJobName(i)
ProductionWorkBook.Sheets("Production Schedule").Range("A" & StartRow).Value = EstJobName(i)
Unless you mean the column is a named range you defined?
ProductionWorkBook.Sheets("Production Schedule").Range("E"& StartRow).Value = ...
will do the job.
Though keep in mind that using hard coded references like the column letter will risk that the macro breaks when the sheet is edited (e.g. a column is inserted). It's therefore better to use a named range and Offset to access:
ProductionWorkBook.Sheets("Production Schedule").Range("StartCell").Offset(StartRow-1).Value
Now you only need to provide the name StartCellto your fist cell (make sure that it's a local name in the Name Manager)