I am currently automating a sales report with VBA and I am having trouble with inserting a formula using VBA with a dynamic range. My Formula with Lookup finds the last week that a client ordered.
The current week is the last week and is always the column prior to the Total column. I am having trouble referencing that last column with the current week.
=LOOKUP(2,1/(CL[#[Week 1]:[Week 17]]>0),COLUMN(CL[[#Headers],[Week 1]:[Week 17]]))
I wasn't sure how to reference using headers.
So the first part of my code finds the column number and using the column number I get the Letter reference. Not sure how to use the Letters with my LOOKUP formula
Sub LastOrder()
Dim strSearch As String
Dim strSearchEnd As String
Dim aCell As Range
Dim endCell As Range
Dim startingCol As Variant
Dim endingCol As Variant
Dim colFirstWeek As Variant
Dim ColLastWeek As Variant
Dim firstCheck As Variant
Dim lastCheck As Variant
'find the column number for week 1 and total
strSearch = "Week 1"
strSearchEnd = "Total"
Set aCell = Sheet1.Rows(1).Find(What:=strSearch, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
startingCol = aCell.Column
End If
Set endCell = Sheet1.Rows(1).Find(What:=strSearchEnd, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not endCell Is Nothing Then
endingCol = endCell.Column - 1
'this is used to get column number of current week
End If
'Use letter reference
firstCheck = Split(Cells(, startingCol).Address, "$")(1)
lastCheck = Split(Cells(, endingCol).Address, "$")(1)
Debug.Print (firstCheck)
Debug.Print (lastCheck)
Range("CL[Last Week Ordered]").FormulaR1C1 = _
"LOOKUP(2,1/(firstCheck:lastCheck>0),COLUMN(firstCheck:lastCheck))
You can try this formula :
=LOOKUP(2, 1 / ( [#[Week 1]]:INDEX([#], , COLUMNS([#]) - 1) > 0 ),
COLUMN( [#[Week 1]]:INDEX([#], , COLUMNS([#]) - 1) ) )
Few Excel Functions like INDEX and OFFSET return Range reference, so they can be used with the range operator :, and Range("INDEX(A1:B1, 1, 1)") in VBA.
Related
I have a table of data in a sheet that i am looking to make some adjustments to. I have a single column called "S/R" which will have one of two values in it [Serving OR Returning]. If the value is serving i want to copy the value from a column called "1stServeX" to a new column i have added i called "Server 1st Serve X".
I have written the code below but am beginning to trip myself up and also cannot finish the last part. I am a novice and so have been using other pieces of code i have gained previously to try and piece it together, which is why i need some help.
If i can get this going then i can simply repeat it for all the "Returner" option and all the other columns i need to split too.
Thanks in advance for any help offered.
Public Sub splitServerCoordinates()
'Set a constant for the title of the Server Column
Const HEADER_SR As String = "S/R"
Dim ws As Worksheet
Set ws = Sheets("transition")
Dim strSearch As String
Dim aCell As Range
Dim COL_SR As Long
Dim COL_TARGET As Long
Dim COL_CURRENT As Long
'Find the Column Numbers of the columns we are looking for
strSearch = "S/R"
Set aCell = ws.Rows(1).Find(What:=strSearch, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
COL_SR = aCell.Column
End If
strSearch = "1stServeX"
Set aCell = ws.Rows(1).Find(What:=strSearch, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
COL_CURRENT = aCell.Column
End If
strSearch = "Server 1st Serve X"
Set aCell = ws.Rows(1).Find(What:=strSearch, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
COL_TARGET = aCell.Column
End If
Dim theUsedRange As Range
Dim SRRange As Range
Dim aPlayer As Range
Dim serving As String
Dim returning As String
Dim theCounter As Long
Dim theSequence As Long
ws.Select
' clear out the Target column and add the header again
Set theUsedRange = ActiveSheet.UsedRange
Intersect(theUsedRange, Range(Columns(COL_TARGET), Columns(COL_TARGET))).ClearContents
Columns(COL_SR).Range("A1").Value = HEADER_SR
' reset the used range just in case
Set theUsedRange = ActiveSheet.UsedRange
' Get the used range for the S/R column
Set SRRange = Intersect(theUsedRange, Columns(COL_SR))
'Set value to compare to
serving = "Serving"
' Loop through the S/R column
For Each aPlayer In SRRange
' ignore the header row
If aPlayer <> HEADER_SR Then
' if we are serving then copy the value from COL_CURRENT to COL_TARGET
If aPlayer = serving Then
aPlayer.Offset(-1, COL_TARGET - COL_).Value = STUCK - HERE
End If
End If
Next aPlayer
End Sub
Some refactoring to pull out the column header location parts, and a few other tweaks. Untested, but should get you there.
Public Sub splitServerCoordinates()
Dim ws As Worksheet, c As Range
Dim COL_SR As Long
Dim COL_TARGET As Long
Dim COL_CURRENT As Long
Set ws = Sheets("transition")
'Find the Column Numbers of the columns we are looking for
COL_SR = HeaderColumnNumber(ws.Rows(1), "S/R")
COL_CURRENT = HeaderColumnNumber(ws.Rows(1), "1stServeX")
COL_TARGET = HeaderColumnNumber(ws.Rows(1), "Server 1st Serve X", True) 'add if not found
'exit if missing any required columns
If COL_SR = 0 Or COL_CURRENT = 0 Then
MsgBox "Missing 'S/R' and/or '1stServeX' !"
Exit Sub
End If
'reset target column
ws.Columns(COL_TARGET).ClearContents
ws.Cells(1, COL_TARGET).Value = "Server 1st Serve X"
'loop rows
For Each c In ws.Range(ws.Cells(2, COL_SR), ws.Cells(ws.Rows.Count, COL_SR).End(xlUp)).Cells
If c.Value = "Serving" Then
ws.Cells(c.Row, COL_TARGET).Value = ws.Cells(c.Row, COL_CURRENT).Value
End If
Next c
End Sub
'Find a header position on a row, with option to add it if not found
' Returns zero if header is not found and option to add was not set
Function HeaderColumnNumber(rng As Range, hdr As String, _
Optional AddIfMissing As Boolean = False) As Long
Dim f As Range
Set rng = rng.Cells(1).EntireRow 'only want a full row to look in
Set f = rng.Find(What:=hdr, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not f Is Nothing Then
HeaderColumnNumber = f.Column 'found: return column
Else
'not found: do we add it, or return zero?
If AddIfMissing Then
With rng.Cells(rng.Cells.Count).End(xlToLeft).Offset(0, 1)
.Value = hdr
HeaderColumnNumber = .Column
End With
Else
HeaderColumnNumber = 0
End If
End If
End Function
I got little project in VBA and stuck on below topic.
I need to select range from searched value to first empty cell in H column.
Selected range should looks like this
Selected Range in Excel:
I searched for specific value in column A and if I found it it's being set as first cell in range. ( It works)
Then I need to find last cell in range which is first empty cell in last column.
This is what I've found and try to use
Sub Button()
Dim StringToFind As String
StringToFind = Application.InputBox("Enter string to find", "Find string")
Worksheets("SS19").Activate
ActiveSheet.Range("A:A").Select
Set cell = Selection.Find(What:=StringToFind, After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
cell.Select
With Worksheets("SS19")
Set rr = .Range(ActiveCell, .Cells(.Rows.Count, "H").End(xlUp))
With rr
rr.Parent.Range(.Cells(1, "A"), .Cells(.Rows.Count, "H").End(xlUp).Offset(1, 0)).Select
End With
End With
If cell Is Nothing Then
Worksheets("SS19").Activate
MsgBox "String not found"
End If
I tried to searched for first empty cell in prevously selected range so it won't search the whole column but it doesn't work.
Try this...
Dim StringToFind As String
StringToFind = Application.InputBox("Enter string to find", "Find string")
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet2")
With ws
Dim findCel As Range
Set findCel = .Range("A:A").Find(StringToFind, , , xlWhole, , , False, , False)
Dim lRow As Long
lRow = .Range(findCel.Address).Offset(, 7).End(xlDown).Row + 1
Dim rr As Range
Set rr = .Range("A" & findCel.Row & ":" & "H" & lRow)
rr.Select
End With
I find that using the worksheet's match function is easier than Range.Find when searching a single column.
Option Explicit
Sub Button()
Dim stringToFind As String, m As Variant
Worksheets("SS19").Activate
stringToFind = Application.InputBox("Enter string to find", "Find string", Type:=xlTextValues)
With Worksheets("SS19")
m = Application.Match(stringToFind, .Range("A:A"), 0)
If Not IsError(m) Then
If Not IsEmpty(.Cells(m + 1, "H")) Then
.Range(.Cells(m, "A"), .Cells(m, "H").End(xlDown).Offset(1)).Select
Else
.Range(.Cells(m, "A"), .Cells(m, "H").Offset(1)).Select
End If
End If
End With
End Sub
Using .End(xlDown) could be problematic if the first cell under row m in column H was blank and this should be checked for or you might find the selection reaching too far, possibly all the way down to the bottom of the worksheet. Checking for a non-blank cell will catch this potential problem.
I am trying to use the Range.Find method in VBA to locate the closest previous row number that has a "true" value.
For example, in Column X, there will be a "true" value (row 35), 10 rows with "false," and then "true" again (row 46).
When I get to row 46 in my loop, I need to do a range.find and return row 35.
The code I am using is this:
Worksheets("Data").Cells.Find(True, searchorder:=xlByColumns, searchdirection:=xlNext).Row
What is happening is that I am only finding either the very first "true" value (in this case, row 2), or the very last "true" value (row 24,xxx), as I vary search direction.
What can I do to find only the previous-most "true" value?
You can find the previous row with True by using the After argument in the Find method combined with xlPrevious as the SearchDirection. I have updated the code to add it into a loop, based on your comments.
Since you posted your code, I have edited my answer into your code.
Sub Main()
Dim iCurRow As Long
Dim iCounter As Long
Dim iLastRow As Long
Dim iTempRow As Long
Dim iPreviousRow As Long
Dim iChangeCol As Long
Dim ws As Worksheet
Set ws = Worksheets("Data")
With ws
iChangeCol = .Cells.Find(what:="Change Over?", searchorder:=xlByColumns, searchdirection:=xlNext).Column
iLastRow = .Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
iPreviousRow = 2
For iCounter = 3 To iLastRow
If .Cells(iCounter, iChangeCol).Value = True Then
iTempRow = .Cells.Find(what:=True, After:=.Cells(iCounter, iChangeCol), searchorder:=xlByColumns, searchdirection:=xlPrevious).Row
iPreviousRow = iTempRow
End If
Next iCounter
End With
End Sub
This short snippet uses both the Range.Find method and Range.FindNext method to cycle through all matching cells in column X.
Sub rings_true()
Dim fnd As Range
With Worksheets("Sheet1") `<~~ set this worksheet reference properly
With .Columns(24)
Set fnd = .Find(What:="TRUE", after:=.Cells(.Rows.Count), _
LookIn:=xlValues, LookAt:=xlWhole, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
Do While Not fnd Is Nothing
If MsgBox("Currently at " & fnd.Address(0, 0) & Chr(10) & "exit now...?", vbYesNo + vbQuestion) = vbYes Then
Exit Do
Else
Set fnd = .FindNext(after:=fnd)
End If
Loop
End With
End With
End Sub
The current cell address is reported through a MsgBox function. The same MsgBox offers the user the opportunity to break the loop.
Additional error control might include confirming at least one matching value in column X before entering into the loop.
There are multiple arguments to put into the Find method, regarding what you told us, I suggest that you use :
After:=.Cells(.Rows.Count, 1) to start from the bottom of the column
LookIn:=xlValues
LookAt:=xlWhole
SearchOrder:=xlByRows to look row by row (instead of column by column)
SearchDirection:=xlPrevious to look "back", from bottom to top
MatchCase:=False
SearchFormat:=False
And furthermore, you can use the .Find method into a specific range, so rather than Worksheets("Data").Cells.Find(..., you should use Worksheets("Data").Range("X:X").Find(... to look only in the column X.
Here is your amended code :
Sub test_ilarson007()
Dim FirstAddress As String, PreviousMatch As Range, cF As Range
Worksheets("Data").Activate
With Worksheets("Data").Range("X:X")
'First, define properly the Find method
Set cF = .Find(What:=True, _
After:=ActiveCell, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False, _
SearchFormat:=False)
'If there is a result,
If Not cF Is Nothing Then
FirstAddress = cF.Address
MsgBox "The row containing the previous 'True' in Column X is : " & cF.Row
'keep looking with FindNext method : Not usefull for your example
Do
Set PreviousMatch = cF
Set cF = .FindNext(cF)
'-------------------------------------------------------------
'----Place instructions to execute on the matched cell/row/...
'First match (i.e. Row 46 in your example)
MsgBox PreviousMatch.Row 'Should display 46 (then 35, then ??)
'Second match (i.e. Row 35 in your example)
MsgBox cf.Row 'Should display 35 (then ??, then ??)
'-------------------------------------------------------------
'Look until you find again the first result
Loop While Not cF Is Nothing And cF.Address <> FirstAddress
End If
End With
End Sub
I am trying to count the number of cells containing a specific value ("N") in a specific row which contains a specific word("Hey").
It counts fine for the first sheet but does not work for the next sheet.
Note: "Hey" is always in the second column however the position is not fixed
Here's what I have tried:
Private Sub macro1()
Dim SearchString As String
Dim far As Range
Dim sh As Worksheet
Dim c As Integer, count As Integer, i As Integer
c = 0
count = 0
SearchString = "Hey"
Application.FindFormat.Clear
For Each sh In ActiveWorkbook.Worksheets
sh.Select
Range("B1:B100").Select
Set far = Cells.Find(What:=SearchString, _
After:=sh.Cells(1, 1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=True, _
SearchFormat:=False)
If Not far Is Nothing Then
Application.Goto far
For i = 3 To 23
c = Application.WorksheetFunction.CountIf(Cells(ActiveCell.Row, i), "N")
If c Then
count = count + 1
End If
Next i
End If
Next
MsgBox ("Count= " & count)
End Sub
It did work for me but I note that
you are looking for an exact match of Hey using xlWhole. Use xlPart if you were looking to match "A Hey is in this cell somewhere"
your code has un-necessary selects and the COUNTIF is being applied cell by cell rather than to a range
updated code
Private Sub macro1()
Dim SearchString As String
Dim far As Range
Dim sh As Worksheet
Dim c As Integer, count As Integer
SearchString = "Hey"
For Each sh In ActiveWorkbook.Sheets
Set far = sh.Range("B1:B100").Find(SearchString, , xlValues, xlWhole, xlByRows, xlNext, True, False)
If Not far Is Nothing Then
c = Application.WorksheetFunction.CountIf(far.Resize(1, 22), "N")
count = count + c
End If
Next
MsgBox ("Count= " & count)
End Sub
'Found an interesting one - after 4 hours of tearing my hair out.
It seems that the Excel 2010 VBA won't find a date value in a range of merged-across cells if the first column's width is too narrow for the font size used. (This is similar to Excel VBA being unable to find a date value in a hidden row/column).
3 Possible Solutions: best first
Change the LookIn parameter to xlFormulas.
Widen the column until the macro works with LookIn:=xlValues.
Reduce the font-size until the macro works with LookIn:=xlValues.
Steps to reproduce:
Insert a date into A2 (eg. 7/3).
Merge Across 4 columns (A2:D2) - this is the field for the date to be found
Create a set of sequential dates in cells A4:A35 (eg. 1/3 to 31/3).
Merge Across 4 columns (A4:D35)
Run the following code:
Sub findDate()
Dim myRange As Range
Dim myDate As Date
Dim myFindDate As Date
Dim myRow As Integer
With ActiveSheet
Set myRange = .[A2]
myFindDate = .[A4:D35].Value
On Error Resume Next
myRow = myRange.Find( _
what:=myFindDate, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False).Row
On Error GoTo 0
If myRow <> 0 Then
MsgBox "The date is in row number = " & myRow
Else
MsgBox "Column A too narrow. Either use LookIn:=xlFormulas, widen Column A or reduce the font size."
End If
End With
End Sub
Notice that the message box presents the relevant row number.
Now reduce the width of Column A to 2.4 and run the code again.
Notice the message box produced: Excel VBA is no longer able to find the date!
Here's the code for solution 1, above:
Sub findDate()
Dim myRange As Range
Dim myDate As Date
Dim myFindDate As Date
Dim myRow As Integer
With ActiveSheet
Set myRange = .[A2]
myFindDate = .[A4:D35].Value
On Error Resume Next
myRow = myRange.Find( _
what:=myFindDate, _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False).Row
On Error GoTo 0
If myRow <> 0 Then
MsgBox "The date is in row number = " & myRow
Else
MsgBox "Column A too narrow. Either use LookIn:=xlFormulas, widen Column A or reduce the font size."
End If
End With
End Sub
(The only change is in the LookIn parameter: xlFormulas instead of xlValues)
If you run this second bit of code, the message box will present the row number again.
'Hope this saves someone else the pain it caused me!!
Gary
I followed your "Steps to reproduce" instructions and your example would not work for me.
Some things I have noticed though.
Dim myDate As Date
Dim myFindDate As Date
Dim myRow As Integer
The values may be dates but you are working with ranges.
So start the code correctly,
Dim myRange As Range, myFindDate As Range, myRow As Range
then set the ranges correctly.
Set myRange = [A2]
Set myFindDate = [A4:D35]
Set myRow = myFindDate.Find(what:=myRange, lookat:=xlWhole)
Using the code this way, it does not matter how wide the columns are.
Complete code.
Sub findDateB()
Dim myRange As Range, myFindDate As Range, myRow As Range
Set myRange = [A2]
Set myFindDate = [A4:D35]
Set myRow = myFindDate.Find(what:=myRange, lookat:=xlWhole)
If Not myRow Is Nothing Then
MsgBox "The date is in row number = " & myRow.Row
Else: MsgBox "Not Found"
Exit Sub
End If
End Sub