I'm facing a small mystery with the Find function : if get the "researched string" via the code and put it in a varaible, it don't work (gives "Nothing") but if I replace the variable by the actual search request (between some "" of course), it works fine...
Some code will surely help :
The goal here is to :
get a part code number in one excel file,
then go to another excel file (containing the prices of all the parts),
searching for this part number
and then getting it's price (simple offset) for later usages
I defined MainWrkBk as the main file, where I want to import the data and SecondWkbk as the one where I want to get the part price from
Do While Lin < LastRow
TPICode = Worksheets("C Parts Prices").Range("A" & Lin).Value 'Gets the TPI Code (never know...)
Do While col <= NbCol + 2
PartNumber = Worksheets("C Parts Prices").Range(Split(Cells(1, col).Address, "$")(1) & Lin).Value 'gets the part number stored in the table
PartNumber = CStr(PartNumber) 'it's useless, but for safety...
SecondWkbk.Activate 'Go on the second workbook that has just been opened
Worksheets(PriceListSheet).Range("A1").Select 'this is probably useless
With Worksheets(PriceListSheet).UsedRange
Set SearchResult = .Find(What:=PartNumber, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns)
End With
If SearchResult Is Nothing Then
MainWkbk.Activate
Else
Worksheets(PriceListSheet).UsedRange.Find(What:=PartNumber, LookAt:=xlWhole).Select
If SearchResult = PartNumber Then
PriceEuro = ActiveCell.Offset(0, 2)
PriceDollars = ActiveCell.Offset(0, 5)
MainWkbk.Activate
Worksheets("C Parts Prices").Range(Split(Cells(1, col).Address, "$")(1) & Lin + 2).Value = PriceEuro
ElseIf SearchResult = "" Then
MainWkbk.Activate
End If
End If
'Worksheets(TheYear).Select
'Worksheets(TheYear).Range(Split(Cells(1, col).Address, "$")(1) & Lin).Value = PartNumber
col = col + 1
Loop
col = PosStartColumnNb
Lin = Lin + 3
Loop
So, on the line :
With Worksheets(PriceListSheet).UsedRange
Set SearchResult = .Find(What:=PartNumber, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns).Address
End With
1) If I keep the variable PartNumber, whatever is inside, it give back a "nothing", meaning it don't find the data...
2) On the other hand, if in the code I replace PartNumber by its actual number, something like "BR58JE3SO" it is found immediately...
3)If I replace the line
PartNumber = Worksheets("C Parts Prices").Range(Split(Cells(1, col).Address, "$")(1) & Lin).Value
by a simple PartNumber = "BR58JE3SO" , it works fine...
I, of course, tried it that way too :
Set SearchResult = Worksheets(PriceListSheet).UsedRange.Find(What:=PartNumber, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns)
No difference :(
May someone explain me what's happening, please?
Edit : a small image to show that :
Well, apparently, the only solution would be to create a loop passing through all the cells of the second workbook...
Thank's Find function :'(
Related
I have a tricky situation with my one record, which appears in one line in some documents like you can see below:
Therefore I can't extract my data properly, as the other values are thrown.
The full macro you can find here:
https://dotnetfiddle.net/m1tYvi
but what I tried to do. I tried to set up the IF condition for the total length of the string, which appears in the concerned cell.
https://www.excelfunctions.net/vba-len-function.html
that's why I tried something like this:
Dim L As Integer
L = Len("Is there room in the chamber to install a new closure :")#
Set rngFound = rngSearch.Find(What:=qu(q), Lookat:=xlPart, LookIn:=xlValues)
With datTarget
lrowG = .Cells(.Rows.Count, "G").End(xlUp).Row + 1
If rngFound Is Nothing Then
.Cells(lrowG, "G") = "Not found" ' blank
Else
If rngFound > L Then
rngFound.Copy
.Cells(1, "G").PasteSpecial xlPasteValuesAndNumberFormats
rngFound.Offset(1).Copy
.Cells(lrowG, "G").PasteSpecial xlPasteValuesAndNumberFormats
Else
rngFound.Copy
.Cells(lrowG, "G").PasteSpecial xlPasteValuesAndNumberFormats
End If
End If
.Cells(lrowG, ColSort) = datSource.Parent.Name
End With
but unfortunately, it seems not to work. The effect is exactly the same.
Is there any solution to this issue? How can I extract the record I exactly need (case 2) instead of a whole string after the colon or even different data as the offset has been applied?
I have a list of PO numbers. They look something like (4010059877-TUR36036133 or TUR6039716## 4010073239). I need to be able to narrow the cell down to only the PO number which is the 4010059877 number. The only consistent part about the part I want to exclude is the "TUR########".
I have worked on code that excludes all non-numeric characters, but some of the cells have these "TUR #'s". I worked on a find and replace with a wildcard "*". I have also searched the web and didn't see anything similar.
Find and Replace attempted code
Sub Replace()
Columns("AJ").Replace What:="TUR*", _
Replacement:="", _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=False
End Sub
Replacing all non-numeric characters which leaves behind unwanted numbers behind the TUR########
Dim finRow As String
finRow = Sheets("Data").Range("A20000").End(xlUp).Row
Set myRange = Sheets("Data").Range("AK2:AK" & finRow)
For Each myCell In myRange
LastString = ""
For I = 1 To Len(myCell.Value)
mT = Mid(myCell.Value, I, 1)
If mT Like "[0-9]" Then
tString = mT
Else
tString = ""
End If
LastString = LastString & tString
Next I
myCell.Value = LastString
Next
My expected result would be for the TUR######## to be eliminated and replaced with nothing.
You can use InStr() function and then use that to support Left, such that:
loc = instr(mycell,"TUR")
val = left(mycell.value,loc-1)
Edit1:
Due to SJR's comment, will add an example of handling the issue when "TUR" is found in position 1:
loc = instr(mycell,"TUR")
if loc = 1 then
val = ""
else
val = left(mycell.value,loc-1)
end if
Edit2:
Dim val as long 'assumes you will only have a number in the end
val = right(left(mycell.value,12),11)
mycell.value = val
This should cut the first parenthesis off and have no issues with the info after the 11 digit PO. This could even be specific to the case (a switch) where instr(mycell.value,"TUR") is true, in case you have other possible scenarios.
We can also try doing a regex replacement:
Dim Regex As System.Text.RegularExpressions.Regex
Dim input As String = "4010059877-TUR36036133"
Dim output As String = Regex.Replace(input, "([0-9]+)-TUR[0-9]+", "$1")
Console.WriteLine(output)
This outputs: 4010059877
I am working with a sheet with almost 200 named ranges (each column is a NR). I now would like to make them dynamic i.e. instead of defining them like
PersonID = =RawData!$A$2:$A$100
I want to do it this way
PersonID = OFFSET(RawData!$A$2,0,0,COUNTA(RawData!$A:$A),1)
But I do not want to do this manually! Is there a way to do this in a texteditor outside Excel or is there a way to do this programatically? I already have the 200 NRs done in the first way in place, but the thought of manually go through them all to change is scaring me.
You can do it in VBA. Example to create a new name:
ActiveWorkbook.Names.Add Name:="PersonID", _
RefersTo:="=OFFSET(RawData!$A$2,0,0,COUNTA(RawData!$A:$A),1)"
To edit an already existing name:
ActiveWorkbook.Names("PersonID").RefersTo = _
"=OFFSET(RawData!$A$2,0,1,COUNTA(RawData!$A:$A),1)"
You indicate in a comment that you would also like to iterate through all named ranges to facilitate changing their definition. To loop through all names you can do this:
Dim nm As Name
For Each nm In ActiveWorkbook.Names
Debug.Print nm.Name
Next nm
or this:
Dim i As Long
For i = 1 To ActiveWorkbook.Names.Count
Debug.Print ActiveWorkbook.Names.Item(i).Name
Next i
This seems to be a pretty good tool to have in your toolbox?
Sub MakeRangesDynamic()
Dim i As Long
For i = 1 To ActiveWorkbook.Names.Count
If Not (ActiveWorkbook.Names.Item(i).Name = "NameToExclude1" Xor _
ActiveWorkbook.Names.Item(i).Name = "NameToExclude2" Xor _
ActiveWorkbook.Names.Item(i).Name = "NameToExclude3") Then
FindTheColumn = Mid$(ActiveWorkbook.Names.Item(i).RefersTo, 11, 2)
If Mid$(FindTheColumn, 2, 1) = "$" Then
FindTheColumn = Mid$(FindTheColumn, 1, 1)
Else
FindTheColumn = Mid$(FindTheColumn, 1, 2)
End If
DynNameString = "=OFFSET(RawData!$" & FindTheColumn & "$2,0,0,COUNTA(RawData!$" & FindTheColumn & ":$" & FindTheColumn & "),1)"
Debug.Print DynNameString
'ActiveWorkbook.Names.Item(i).Name.RefersTo = DynNameString
End If
Next i
End Sub
A special thanks goes to Jean-Francois for helping me out.
Change the RawData to your sheetname and the NameToExclude to your ranges to leave untouched.
Remove the last comment for making it happen! But be sure to make a backup copy first!!!!
If I have created a collection, can I search search the collection and RETURN THE INDEX number from within the collection?
Due to my newbie status, I can't post screenshots of what I'm trying to do, so let me try to explain what I'm trying to accomplish:
I have a history log from a warehouse database in Excel format that is several thousand lines long-- each line representing a transaction of product moving in or out of as many as 10 different bins. My goal is to identify all the possible different bins in the thousands of lines, copy/transpose those ~10 bins to column headers, and then go through each transaction and copy the transaction quantity (+1,-3, etc) to the correct column, thus being able separate the transactions and more easily identify and generate an accounting of when product moved in/out of each respective bin. This would sort of look like a PivotTable, but that isn't really how it would work.
Here is the code I am working on so far, with comments. My problem is explained in the last comment:
Sub ForensicInventory()
Dim BINLOCAT As Collection
Dim Rng As Range
Dim Cell As Range
Dim sh As Worksheet
Dim vNum As Variant
Dim BINcol As Integer
Dim ACTcol As Integer
Dim QTYcol As Integer
Dim i As Integer
Dim lastrow As Long
Dim x As Long
'This part is used to find the relevant columns that will be used later
BINcol = ActiveSheet.Cells(1, 1).EntireRow.Find(What:="BINLABEL", LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
ACTcol = ActiveSheet.Cells(1, 1).EntireRow.Find(What:="ACTION", LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
QTYcol = ActiveSheet.Cells(1, 1).EntireRow.Find(What:="QUANTITY", LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
i = 0
Set sh = ActiveWorkbook.ActiveSheet
Set Rng = sh.Range(sh.Cells(2, BINcol), sh.Cells(Rows.Count, BINcol).End(xlUp))
Set BINLOCAT = New Collection
'This next section searches the bin column and builds the collection of unique bins that I am interested in.
On Error Resume Next
For Each Cell In Rng.Cells
If Len(Cell.Value) <> 8 And Not IsEmpty(Cell) Then
BINLOCAT.Add Cell.Value, CStr(Cell.Value)
End If
Next Cell
On Error GoTo 0
'Now I take those unique bin names and I put them into a column header on the same spreadsheet, starting in column 10, and spacing every 2 cells thereafter.
For Each vNum In BINLOCAT
Cells(1, 10 + i).Value = vNum
i = i + 2
Next vNum
'Here is where the problem exists for me. This code works and succeeds in copying the QTY
'to column 10, but what I really want to do is determine the index number of the bin from BINLOCAT,
'and use that index number to place the value under the appropriate column header.
For x = 2 To lastrow
Select Case Cells(x, ACTcol).Value
Case "MOVE-IN"
Cells(x, 10).Value = Cells(x, QTYcol).Value
Case "MOVE-OUT"
Cells(x, 10).Value = -Cells(x, QTYcol).Value
Case Else
End Select
Next x
End Sub
In the "For x = 2 to lastrow" loop, I need to find a way to get the INDEX number (1, 2, 3, etc.) from searching for the bin in collection BINLOCAT. BINLOCAT, once created, is static. I envision something like:
neededcolumn = BINLOCAT.item(cells(x,BINcol).value).index (pseudocode)
Then I would replace the 10s in the Case Stmt with "neededcolumn" and this would work.
Maybe I am taking the wrong approach, but it seems to me like I need the collection to be able to do the search portion efficiently. Any thoughts or links to a solution? Based on what I've read, elsewhere, I think that this ability as I'm describing it is not available, but I'm not sure I've understood everything I've read about collections thus far.
Instead of using a for each loop, use a for n = 1 to BINLOCAT.Count loop - then n is your index. Or did I misunderstand?
Disclaimer: Okay, I am going to answer my own question, but I was led to this answer based on #Rory's comment at 13:07 on 8/18. So, thank you, Rory! Rory's answer proper did not enlighten me in the way I needed (or I'm too dumb to see it -- always possible), so I'm not accepting his answer but I want to acknowledge his help. I still suspect there might be a better way than what I am doing, so please feel free to comment/answer/correct me.
In the interest of simplicity and thoroughness, assume the following starting data:
Range("A1:A16")=
BM182B
BM182B
BM182B
BM182B
BM182B
AS662B
BM182B
BM182B
BM182B
BM182B
AS702B
AS642B
BM182B
BM182B
BM182B
BM182B
Based on Rory's comment, this is the first piece of code I came up with:
Sub TestofCollection()
Dim BinCollection1 As Collection
Dim n As Integer
Dim x As Integer
Set BinCollection1 = New Collection
n = 1
On Error Resume Next
For Each Cell In Range("A1:A16")
BinCollection1.Add n, CStr(Cell.Value)
n = n + 1
Next Cell
On Error GoTo 0
For x = 1 To BinCollection1.Count
Range("B" & x).Value = BinCollection1.Item(x)
Next x
End Sub
The problem with this is that output, or the "index" I get, is actually the positional location of each bin during its first occurrence in the list. So the result in the output segment is "1,6,11,12" rather than the desired "1,2,3,4" for the list "BM182B, AS662B, AS702B, AS642B". Whether there is a better way, I do not know, but my solution was to create a "collection of a collection" as follows in the next code:
Sub TestofCollection2()
Dim BinCollection1 As Collection
Dim BinCollection2 As Collection
Set BinCollection1 = New Collection
Set BinCollection2 = New Collection
n = 1
On Error Resume Next
For Each Cell In Range("A1:A16")
BinCollection1.Add Cell.Value, CStr(Cell.Value)
Next Cell
For Each x In BinCollection1
BinCollection2.Add n, BinCollection1.Item(x)
n = n + 1
Next x
On Error GoTo 0
For x = 1 To BinCollection2.Count
Range("C" & x).Value = BinCollection2.Item(x)
Next x
'Test output result should be 3 below
MsgBox "Test Output: " & BinCollection2.Item("as702b")
End Sub
So now, based on this double-collection effort, I can search my multi-thousand line columns of bins and determine their index to create my offset. The index shows up as "1,2,3,4" using those keys in the list.
This is my first question and first answer on Stack Overflow. I will probably give this a couple days to see if anyone has a better answer, but then I will "accept" my own answer here since this is what helped me (can I "unaccept" my answer if a better one shows up later?). Again, comments or suggestions greatly appreciated and accepted. Thank you for viewing.
Good Day,
really need some help here, im bad at VBA.
Had created a spreadsheet and recorded a macro to record checkin of staff. However, im having difficulties checking out with the corresponding users based on the name.
Could anyone help me out over here?
Thanks. Had attached the spreadsheet for your ref.
http://www.etechnopia.com/vish/Book1ss.xlsm
After much googling, This is what i did based on mikes solution
Dim name As String
Dim id As Integer
Dim checkin As Date
Dim checkout As Date
name = Range("d6").Value
id = Range("d7").Value
checkin = Now
Range("d10") = checkin
Help anyone? im my very best here.
firstly I recommend to use range names for the important cells of your sheet
D6 EmpName
D7 EmpNo
D10 ClockInTime
D11 ClockOutTime
H5..H11 DataTable
This will enable you to reference them by name instead of hardcoding their addresses (bad bad hardcoding :-/ )
Secondly, your [Button] must serve a dual purpose ... it has to decide if a user is clocked in or out and do different things
a hi-level META code, executed at pressing [Button4] could be
if user clocked in
write current time into ClockOutTime ' remark: this may be superfluous
find DataTable record (EmpName, ClockInTime)
write ClockOutTime into record (EmpName, ClockInTime)
erase EmpName, EmpID, ClockInTime, ClockOutTime
else
write current time into ClockInTime
find first blank record in DataTable
write EmpName, EmpID, ClockInTime into DataTable record
endif
How to decide if a user is clocked in? If many users are using the same sheet at the same time (meaning 5 emps go there, write in their names and clock in) you need to examine DataTable for the first record of EmpNane without a ClockOutTime - if found he/she is in and needs to be clocked out.
more later ...
OK ... sorry was interrupted by Lady Gaga concerto in Vienna/AT
so here's a full code for the button
Sub ButtonPressed()
Dim DB As Range, Idx As Integer
Set DB = Range("DataTable")
If Range("EmpName") = "" Or Range("EmpNo") = "" Then
MsgBox "Enter your name and ID before pressing the button", vbCritical + vbOKOnly, "missing input"
Exit Sub
End If
Idx = UserClockedIn()
If Idx <> 0 Then
DB(Idx, 4) = Date + Time()
DB(Idx, 5).Formula = "=" & DB(Idx, 4).Address(RowAbsolute:=False, ColumnAbsolute:=False) & "-" & DB(Idx, 3).Address(RowAbsolute:=False, ColumnAbsolute:=False)
DB(Idx, 5).NumberFormat = "[hh]:mm"
Range("EmpName") = ""
Range("EmpNo") = ""
Else
Idx = 2
Do While DB(Idx, 1) <> ""
Idx = Idx + 1
Loop
DB(Idx, 1) = Range("EmpName")
DB(Idx, 2) = Range("EmpNo")
DB(Idx, 3) = Date + Time()
End If
End Sub
Private Function UserClockedIn() As Integer
Dim DB As Range, Idx As Integer
Set DB = Range("DataTable")
UserClockedIn = 0
Idx = 2
Do While DB(Idx, 1) <> ""
If DB(Idx, 1) = Range("EmpName") And DB(Idx, 2) = Range("EmpNo") And DB(Idx, 4) = "" Then
UserClockedIn = Idx
Exit Function
End If
Idx = Idx + 1
Loop
End Function
#user502908: I have not documented it because I want you to find out exactly what it does and by that have a quick start into Excel-VBA :-) It doesn't do too much and there are some basic thechniques you will apply again & again if you go into VBA ... try to populate ranges "ClockInTime" and "ClockOutTime" :-)))
Book1ssNew.xlsm
have fun
I tried another simpler method which i could cope with
Sub yes()
Dim findId As Integer
Dim FirstAddress As String
Dim FindString As Integer
Dim Rng As Range
FindString = Range("d7").Value
If Trim(FindString) <> "" Then
With Sheets("Sheet1").Range("F1:J100")
Set Rng = .find(What:=FindString, _
After:=.Cells(1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
If Not Rng Is Nothing Then
Application.Goto Rng, True
FirstAddress = Rng.Address
Rng.Offset(0, 2).Value = Now()
Else
MsgBox "Nothing found"
End If
End With
End If
End Sub
Search entire spreadsheet given id, when id found, to indicate dynamically the checkin timing.