I'm trying to build a macro that will search a given cell for a certain character combination in a specific order, and then paste this to another page. I need it to search a cell that contains a 9 letter/number combination for '9P', but only if it's the third and fourth number/letter in.
So if given these list of entries:
NA9PK99LJ
NA9PK99LK
XX9P109LH
XX9P109XF
XX849P01D
NA8419PZ3
XX9P109VK
I'd only want it to copy the first four and the last entry, and then past these vertically starting in A2 on another page.
I'm somewhat of a novice to excel vba, but I'm told this should be doable.
Any help would be much appreciated!
Thanks
Chris
Hope this helps, may have gone over board
Sub Solution()
Dim search As String, start As Integer, lastaddress As String, toworksheet As String
lastaddress = "A2" 'cell location on the result sheet
search = InputBox("Enter Search Critera") 'enter search critera
start = InputBox("Start from") 'integer of where to search in the string, not zero index
toworksheet = InputBox("Put results into which spreadsheet") 'worksheet name to put results
'select the cell you want to start your search from and it will continue till it reaches a blank cell
Do While ActiveCell.Text <> ""
'Performs the test
If Mid(ActiveCell.Text, start, Len(search)) = search Then
'adds the entry to the results sheet
Worksheets(toworksheet).Cells.Range(lastaddress).Value = ActiveCell.Text
'updates the address to the next line in your results sheet
lastaddress = Worksheets(toworksheet).Cells.Range(lastaddress).Offset(1, 0).Address
End If
'goes to next item in list
ActiveCell.Offset(1, 0).Select
Loop
End Sub
The easiest way I know of is to use Find() with wildcards. What you can do is use the macro recorder while doing the following:
Start the macro recorder
Select the range to search
Do Ctrl + F and enter ??9P????? into the search terms
Select all the results in the box
Close the box, copy the cells and paste them where you want
Stop the macro recorder
This will give you the main base of your code which you can then fine tune so that it does what you need. This is also a good exercice for you to learn how VBA works.
Related
I have a list of serial numbers with a prefix, and then a few numbers. All serial numbers are 8 characters, so depending on the prefix and amount of zeros, different amounts of leading zeros are added between the prefix and numbers. (ex. ALT00001, CAT00564, AAR19470, M0000003, MISC7859, MISC0025)
How can I remove all leading zeros from the Serial Numbers, but keep any zeros that are part of the actual number?
I would love to create a macro that does this, as I would have to run this code on multiple workbooks countless times a day.
With data in column A, in B1 enter:
=LEFT(A1,3) & --RIGHT(A1,5)
and copy downwards.
EDIT#1:
Based on the updated examples, we must find the position of the first numeral in the string and parse based on that.
In C1 enter:
=MIN(FIND({"0","1","2","3","4","5","6","7","8","9"},UPPER(A1)&"0123456789"))
and copy downwards. (this give the position of the first numeral)
Now in B1 enter:
=LEFT(A1,C1-1) & --RIGHT(A1,8-C1+1)
or:
=LEFT(A1,C1-1) & --RIGHT(A1,9-C1)
(if you don't want the "helper" column, combine the formulas)
EDIT#2:
Here is some code:
Sub Deb()
Dim Kolumn As String, rng As Range, cell As Range, s As String, L As Long
Dim i As Long
Kolumn = "A"
Set rng = Intersect(Columns(Kolumn).EntireColumn, ActiveSheet.UsedRange).Offset(1, 0).Cells
For Each cell In rng
s = cell.Value
If s = "" Then Exit Sub
L = Len(s)
For i = 1 To L
If IsNumeric(Mid(s, i, 1)) Then
GoTo Process
End If
Next i
MsgBox "bad data " & s
Exit Sub
Process:
cell.Value = Left(s, i + -1) & CLng(Mid(s, i))
Next cell
End Sub
EDIT#3:
Macros are very easy to install and use:
ALT-F11 brings up the VBE window
ALT-I
ALT-M opens a fresh module
paste the stuff in and close the VBE window
If you save the workbook, the macro will be saved with it.
If you are using a version of Excel later then 2003, you must save
the file as .xlsm rather than .xlsx
To remove the macro:
bring up the VBE window as above
clear the code out
close the VBE window
To use the macro from the Excel window:
Select the worksheet you want the macro to run on
ALT-F8
Select the macro
Touch RUN
To learn more about macros in general, see:
http://www.mvps.org/dmcritchie/excel/getstarted.htm
and
http://msdn.microsoft.com/en-us/library/ee814735(v=office.14).aspx
Macros must be enabled for this to work!
EDIT#4:
This code check for errors:
Sub Deb_2()
Dim Kolumn As String, rng As Range, cell As Range, s As String, L As Long
Dim i As Long
Kolumn = "A"
Set rng = Intersect(Columns(Kolumn).EntireColumn, ActiveSheet.UsedRange).Offset(1, 0).Cells
For Each cell In rng
s = cell.Value
If s = "" Then Exit Sub
L = Len(s)
For i = 1 To L
If IsNumeric(Mid(s, i, 1)) Then
GoTo Process
End If
Next i
MsgBox "bad data " & s
Exit Sub
Process:
If IsNumeric(Mid(s, i)) Then
cell.Value = Left(s, i + -1) & CLng(Mid(s, i))
End If
Next cell
End Sub
I have two approaches, one is using excel array formula to find the numerical value in the text string, and the other is using excel power query to transform the data in 4 simple steps.
Approach 1 - Array Formula
The following formula will firstly convert the text string to array, eg. ALT00001 will become {"A";"L";"T";"0";"0";"0";"0";"1"}, then examine each character in the array if it is a numerical value like this {FALSE;FALSE;FALSE;TRUE;TRUE;TRUE;TRUE;TRUE}, and lastly sum up all the TRUE results. This will give you the total number of numerical values in the text string.
{=SUM(--ISNUMBER(--MID(A1,ROW(INDIRECT("1:"&LEN(A1))),1)))}
Please note this is an array formula so you need to press CSE (Ctrl+Shift+Enter) upon finishing editing the formula.
In my workings, I entered the array formula in Cell B1, then in Cell C1 I entered the following formula to get the result.
=LEFT(A1,8-B1)&--RIGHT(A1,B1)
You can combine these two formulas but it will look awkwardly long and not so easy to interpret by others. If you do combine, you need to press CSE to make it work as it incorporates an array.
Approach 2 - Power Query
Although #Deb did not ask for a solution using Power Query (PQ), I still want to share an alternative way of solving the issue efficiently, given that the above formula-based solution is not so straight forward and somehow complicated.
PQ is able to transform data from multiple worksheets and have ample built-in functions that is quite user friendly. Please note you need to have Excel 2010 or later versions to be able to use PQ.
So here are the steps using PQ:
1) Load the data range to PQ Editor, one way of doing that is to highlight the data range and use From Table in the Data tab as shown below:
2) Once loaded, the PQ Editor will be opened in a new window. The next step is to separate the value into Text string and Numerical string. A quick way of doing that is to use the Split Column (By Non-digit to Digit) in the Transform tab of the PQ Editor as shown below.
3) Now we have the text in the first column and the number in the second column. Next step is to clear the "0" in front of the values in the number column. One way of doing that is to change the Data Type from Text to Whole Number, and then change it back to Text (I will explain why you need to change it back to Text in the next step).
4) Next step is to combine the two columns to get the desired result. One way of doing that is to add a custom column and use & to combine the values from the two columns as shown below.
=[Column1.1]&[Column1.2] the way of using & is same as in an excel formula
As mentioned in my last step, we need to change the number value back to text, the reason is that PQ Editor does not allow combining a text value with a numerical value, it will lead to the following error.
5) The last step will vary depends on your preference. What I did is to remove other columns and load the Result column to the current worksheet where your original data sits.
Unfortunately PQ could not over write source data. However in my opinion it is better to keep your source data somewhere safe without being overwritten, and export your edited/transformed data to a new place and work on it instead.
Here are the codes behind the scene but all steps are performed using the built-in functions which you can google the know-how of each of them easily.
let
Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
#"Split Column by Character Transition" = Table.SplitColumn(Source, "Column1", Splitter.SplitTextByCharacterTransition((c) => not List.Contains({"0".."9"}, c), {"0".."9"}), {"Column1.1", "Column1.2"}),
#"Changed Type1" = Table.TransformColumnTypes(#"Split Column by Character Transition",{{"Column1.2", Int64.Type}}),
#"Changed Type2" = Table.TransformColumnTypes(#"Changed Type1",{{"Column1.2", type text}}),
#"Added Custom" = Table.AddColumn(#"Changed Type2", "Result", each [Column1.1]&[Column1.2]),
#"Removed Other Columns" = Table.SelectColumns(#"Added Custom",{"Result"})
in
#"Removed Other Columns"
Cheers :)
I have a very large embedded IF formula that appears to occasionally break for no reason. Opening and closing the page a few times eventually gets it working again. I am wondering if there is a VBA alternative for it. Here is the IF formula I am running.
=IF(ISNUMBER(SEARCH("76210",E125)),"_012_00762_10",IF(ISNUMBER(SEARCH("76220",E125)),"_012_00762_20",IF(ISNUMBER(SEARCH("76900",E125)),"_012_00769_00",IF(ISNUMBER(SEARCH("76901",E125)),"_012_00769_01",IF(ISNUMBER(SEARCH("85702",E125)),"_012_00857_02",IF(ISNUMBER(SEARCH("85710",E125)),"_012_00857_10",IF(ISNUMBER(SEARCH("100800",E125)),"_012_01008_00",IF(ISNUMBER(SEARCH("100900",E125)),"_012_01009_00",IF(ISNUMBER(SEARCH("123100",E125)),"_012_01231_00",IF(ISNUMBER(SEARCH("124600",E125)),"_012_01246_00",IF(ISNUMBER(SEARCH("124601",E125)),"_012_01246_01",IF(ISNUMBER(SEARCH("124640",E125)),"_012_01246_40",IF(ISNUMBER(SEARCH("124641",E125)),"_012_01246_41",IF(ISNUMBER(SEARCH("142301",E125)),"_012_01423_01",IF(ISNUMBER(SEARCH("158801",E125)),"_012_01588_01",IF(ISNUMBER(SEARCH("158900",E125)),"_012_01589_00",IF(ISNUMBER(SEARCH("159203",E125)),"_012_01592_03",IF(ISNUMBER(SEARCH("159303",E125)),"_012_01593_03",IF(ISNUMBER(SEARCH("159401",E125)),"_012_01594_01",IF(ISNUMBER(SEARCH("159410",E125)),"_012_01594_10",IF(ISNUMBER(SEARCH("159420",E125)),"_012_01594_20",IF(ISNUMBER(SEARCH("159501",E125)),"_012_01595_01",IF(ISNUMBER(SEARCH("169000",E125)),"_012_01690_00",IF(ISNUMBER(SEARCH("186900",E125)),"_012_01869_00",IF(ISNUMBER(SEARCH("213200",E125)),"_012_02132_00",IF(ISNUMBER(SEARCH("213300",E125)),"_012_02133_00",IF(ISNUMBER(SEARCH("215400",E125)),"_012_02154_00",IF(ISNUMBER(SEARCH("220100",E125)),"_012_02201_00",IF(ISNUMBER(SEARCH("223800",E125)),"_012_02238_00",IF(ISNUMBER(SEARCH("225600",E125)),"_012_02256_00",IF(ISNUMBER(SEARCH("230700",E125)),"_012_02307_00",IF(ISNUMBER(SEARCH("230701",E125)),"_012_02307_01",IF(ISNUMBER(SEARCH("231800",E125)),"_012_02318_00",IF(ISNUMBER(SEARCH("235000",E125)),"_012_02350_00",IF(ISNUMBER(SEARCH("235020",E125)),"_012_02350_20",IF(ISNUMBER(SEARCH("242000",E125)),"_012_02420_00",IF(ISNUMBER(SEARCH("246400",E125)),"_012_02464_00",IF(ISNUMBER(SEARCH("292900",E125)),"_012_02929_00",""))))))))))))))))))))))))))))))))))))))
Basically it is built so a serial number is scanned and it populates a cell for the users who use this sheet with its results from the search. I am already running one macro in this sheet as well. Here is that...
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Intersect(Range("A2:A500, J2:J500"), Target) ' define range of interest
If Not rng Is Nothing Then ' check it's not "nothing"
If WorksheetFunction.CountA(rng) = rng.Count Then 'check for all of its cells being not empty
On Error GoTo safe_exit 'add error control
Application.EnableEvents = False 'don't do anything until you know something has to be done
rng.Offset(, 1).Value = Date 'write Date next to all relevant changed cells
End If
End If
safe_exit:
Application.EnableEvents = True
End Sub
Maybe there is a better way to build this search using a formula that isn't using embedded IF statements, but i couldn't think of another way to do it. Thanks in advance.
This may be what you're looking for:
=IF(ISNA(MATCH(1,IF(ISERR(SEARCH($A$5:$A$42,$E$125)),0,1),0)),"",INDEX($B$5:$B$42,MATCH(1,IF(ISERR(SEARCH($A$5:$A$42,$E$125)),0,1),0)))
entered as an array formula (CTRL-SHIFT-ENTER).
Here $A$5:$A$42 contains 76210, 76220, ... , 292900 (entered as text, not numbers); and $B$5:$B$42 contains _012_00762_10, _012_00762_20, ... , _012_02929_00.
Hope that helps.
Any time you have to go more than 2 deep on an IF you may want to rethink the usage.
What you can do is build a table from your values. Then reference that table as part of your lookup. Assuming your list of value is in range D8:E45 you could use the formula =VLOOKUP(E125,$D$8:$E$45,2).
The beginning of your table would look like what's seen below. The input result cell is referencing your input value and pulling the match of the second column.
To get your table you can take your source formula and replace (Find and Replace - Ctrl+H) some characters with unique delimiting characters. Then use Text To Columns Alt+D+E and delimit and Copy>Paste special>Transpose to quickly have it close to the format you need.
The Problem
Assume that the active cell contains a formula based on the INDEX function:
=INDEX(myrange, x,y)
I would like to build a macro that locates the value found value by INDEX and moves the focus there, that is a macro changing the active cell to:
Range("myrange").Cells(x,y)
Doing the job without macros (slow but it works)
Apart from trivially moving the selection to myrange and manually counting x rows y and columns, one can:
Copy and paste the formula in another cell as follows:
=CELL("address", INDEX(myrange, x,y))
(that shows the address of the cell matched by INDEX).
Copy the result of the formula above.
Hit F5, Ctrl-V, Enter (paste the copied address in the GoTo dialog).
You are now located on the very cell found by the INDEX function.
Now the challenge is to automate these steps (or similar ones) with a macro.
Tentative macros (not working)
Tentative 1
WorksheetFunction.CELL("address", ActiveCell.Formula)
It doesn't work since CELL for some reason is not part of the members of WorksheetFunction.
Tentative 2
This method involves parsing the INDEX-formula.
Sub GoToIndex()
Dim form As String, rng As String, row As String, col As String
form = ActiveCell.Formula
form = Split(form, "(")(1)
rng = Split(form, ",")(0)
row = Split(form, ",")(1)
col = Split(Split(form, ",")(2), ")")(0)
Range(rng).Cells(row, CInt(col)).Select
End Sub
This method actually works, but only for a simple case, where the main INDEX-formula has no nested subformulas.
Note
Obviously in a real case myrange, x and ycan be both simple values, such as =INDEX(A1:D10, 1,1), or values returned from complex expressions. Typically x, y are the results of a MATCH function.
EDIT
It was discovered that some solutions do not work when myrange is located on a sheet different from that hosting =INDEX(myrange ...).
They are common practice in financial reporting, where some sheets have the main statements whose entries are recalled from others via an INDEX+MATCH formula.
Unfortunately it is just when the found value is located on a "far" report out of sight that you need more the jump-to-the-cell function.
The task could be done in one line much simpler than any other method:
Sub GoToIndex()
Application.Evaluate(ActiveCell.Formula).Select
End Sub
Application.Evaluate(ActiveCell.Formula) returns a range object from which the CELL function gets properties when called from sheets.
EDIT
For navigating from another sheet you should first activate the target sheet:
Option Explicit
Sub GoToIndex()
Dim r As Range
Set r = Application.Evaluate(ActiveCell.Formula)
r.Worksheet.Activate
r.Select
End Sub
Add error handling for a general case:
Option Explicit
Sub GoToIndex()
Dim r As Range
On Error Resume Next ' errors off
Set r = Application.Evaluate(ActiveCell.Formula) ' will work only if the result is a range
On Error GoTo 0 ' errors on
If Not (r Is Nothing) Then
r.Worksheet.Activate
r.Select
End If
End Sub
There are several approaches to select the cell that a formula refers to...
Assume the active cell contains: =INDEX(myrange,x,y).
From the Worksheet, you could try any of these:
Copy the formula from the formula bar and paste into the name box (to the left of the formula bar)
Define the formula as a name, say A. Then type A into the Goto box or (name box)
Insert hyperlink > Existing File or Web page > Address: #INDEX(myrange,x,y)
Adapt the formula to make it a hyperlink: =HYPERLINK("#INDEX(myrange,x,y)")
Or from the VBA editor, either of these should do the trick:
Application.Goto Activecell.FormulaR1C1
Range(Activecell.Formula).Select
Additional Note:
If the cell contains a formula that refers to relative references such as =INDEX(A:A,ROW(),1) the last of these would need some tweaking. (Also see: Excel Evaluate formula error). To allow for this you could try:
Range(Evaluate("cell(""address""," & Mid(ActiveCell.Formula, 2) & ")")).Select
This problem doesn't seem to occur with R1C1 references used in Application.Goto or:
ThisWorkbook.FollowHyperlink "#" & mid(ActiveCell.FormulaR1C1,2)
You could use the MATCH() worksheet function or the VBA FIND() method.
EDIT#1
As you correctly pointed out, INDEX will return a value that may appear many times within the range, but INDEX will always return a value from some fixed spot, say
=INDEX(A1:K100,3,7)
will always give the value in cell G3 so the address is "builtin" to the formula
If, however, we have something like:
=INDEX(A1:K100,Z100,Z101)
Then we would require a macro to parse the formula and evaluate the arguments.
Both #lori_m and #V.B. gave brilliant solutions in their own way almost in parallel.
Very difficult for me to choose the closing answer, but V.B. even created Dropbox test file, so...
Here I just steal the best from parts from them.
'Move to cell found by Index()
Sub GoToIndex()
On Error GoTo ErrorHandler
Application.Goto ActiveCell.FormulaR1C1 ' will work only if the result is a range
Exit Sub
ErrorHandler:
MsgBox ("Active cell does not evaluate to a range")
End Sub
I associated this "jump" macro with CTRL-j and it works like a charm.
If you use balance sheet like worksheets (where INDEX-formulas, selecting entries from other sheets, are very common), I really suggest you to try it.
I have a spread sheet that is updated weekly. What i need to do is cut come of the cells and paste to a new location. I have never used macros or VBA before but I am getting frustrated with the amount of time I spend doing this. I know that I can use a macro but don't know how to write it.
I am trying to move the name of the hotel and resort to the left of the passengers title
R81C00 CHALET LE VALENTIN SAUZE D'OULX
MR HAYHOE 8
MR GLOVER 2
This repeats throughout the spread sheet. The number of lines between the names is dependent on information further right in the sheet.
546L
__________1 RESORT INFORMATION
__________5 SKI/S.BOARD CARRIAGE
__________8 AD L/P BRN BF 31/12/99
what I would like to do here is move these lines onto the same line as the flight number (this is the same line as passenger details) and then delete the lines with no data. this way all the details would be on the same line and then i would just need to fill down for the hotel names.
thanks in advance for any help please let me know if i haven't explained it clearly.
Trying to keep this general enough to be of use to other people, the basic process to follow would be:
find the next hotel/resort combination
find each passenger for that hotel/resort
add in the details for the other attributes
move on to the next passenger
move on to the next hotel/resort
If we start with finding the hotel/resort combination and we assume that this is on Sheet1 in column A in a single cell and that nothing else is in column A then we would need this macro:
Option Explicit
Sub main()
Dim lngCurrRow As Long
Dim lngMaxRow As Long
With ThisWorkbook.Worksheets("Sheet1")
lngMaxRow = .UsedRange.Rows.Count
For lngCurrRow = 1 To lngMaxRow
If (.Cells(lngCurrRow, 1).Value <> "") Then
MsgBox .Cells(lngCurrRow, 1).Value
End If
Next lngCurrRow
End With
End Sub
This should pop up a message box with the name of each hotel/resort in turn.
All the code does is work out how many used rows there are on the worksheet (and stores that in lngMaxRow) and then works through every used row (using lngCurrRow to keep track of which row we are on) checking the value of the cell in column A on that row (the .Cells(lngCurrRow, 1).Value part). If there is something in that cell (the (<> "" part) then it displays the value of that cell.
The more difficult case is when there is other data in column A (e.g. if the passenger names were also in column A). In that scenario, we need a way to easily recognise what is a hotel/resort combination and what is a passenger name but I don't have enough info about your current structure to determine how to do that
Hello i want to make a form that have 2 or 3 text boxes that i can enter text values in it and vba search for this values if they are matched in 1 cell like if i enter "hello" in the first text box then i entered "world" in the other text box it search the hall collumn for a range that have "hello world" in it then copy paste it to another sheet and there are maybe multiple cells that have the same values till now i was able to do that for one value only , then i tried altering it to match wat i need but i couldnt here is wat i am at :
Private Sub CommandButton1_Click()
Dim rng As range
For Each rng In Worksheets("sheet1").range("a:a")
If rng.Value = TextBox1 Then
rng.EntireRow.Select
Selection.Copy Destination:=Worksheets("Sheet2").range("A" & Worksheets("Sheet2").range("A65536").End(xlUp).Row + 1)
End If
Next rng
End Sub
and actualy this one only works on finding the cell that only have the word i am searching for per example if i am searchin for "Java" and there is a cell that have .net and java it doesnt consider it in the copy process and i want it to find any cell with the search values i gave it
tyvm
I am not sure whether I totally got your question. But if you want to know whether one value is in a cell and another one. You need to use InStr.
The IF Statement above would look something like this (haven't tested it but should work)
If InStr(rng.Value, TextBox1) > 0 and InStr(rng.Value, TextBox2) > 0 then
Hope it helps.