Remove zeros from middle of string - vba

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 :)

Related

Order of Operations with WITH Statement, IF Statement and VLOOKUP Formula in VBA

Working on this process where I have to take formulas (mostly VLOOKUP formulas) listed in the top row of this section, perform and find/replace, remove the apostrophe placed in front of the formula and drag down formula to appropriate rows. The process is as follows:
Copy the formulas in cells AT1:BZ1 and paste them in AT4:BZ4
If cell contains "Last Weeks Summary Report Name", replace it with "This Weeks Summary Report Name". (35 replacements)
If cell contains "Last Weeks Final Report Name", replace it with "This Weeks Final Report Name." (3 replacements)
If cell has an apostrophe as its first character, remove it.
Click and Drag all formulas to Row 5000.
Copy all cells in the array and paste them as values (to reduce size of file)
I am able to perform these steps individually, but I run into difficulties when trying to combine the steps of the process. My problem I think lies with the order in which I perform these tasks and not having the knowledge of how to nest IF statements within a WITH statement. Additionally, I'm having difficulties in using the Immediate window with the WITH statement. Here's what I have so far:
Dim wb_Final As Workbook, nameFinal As String
Set wb_Final = Workbooks.Open(Filename:=Final_Directory)
nameFinal = wb_Final.Name
Dim wb_Summary As Workbook, nameSummary As String
Set wb_Summary = Workbooks.Open(Filename:=Summary_Directory)
nameSummary = wb_Summary.Name
wb_Summary.Sheets("Sheets 1").Activate
Range("AT1:BZ1").Copy
Range("AT4:BZ4").PasteSpecial xlPasteAll
Application.CutCopyMode = False
' This is where my problem is:
For Each C In Worksheets("Sheets 1").Range("AT4:BZ4").Cells
'If cell is blank
'Else
'If LEFT(cell, 1) = "'"
Replace(cell, "'", "")
etc..
I have tried a different approach to this process that can be seen here. This process makes a lot more sense to me, but generates an error that I can't figure out.
I have also thought about defining the range and create a DO UNTIL IS NOTHING and loop it through.
Any help would be much appreciated :)

Embedded "IF" formula breaks occasionally, VBA alternative?

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.

Issue using Instr with Cell Formats

I have a puzzle that i've trying to solve for some time. I have a spreadsheet that imports data from a .csv file, which worls well apart from the intial location setting.
I currently run a search to find the last cell that contains a value and use that as the starting point. Now for reason above and beyond me this sometimes fails and places the starting point halfway down the spreadsheet. SO to get around this I decided to write a check code or a more sophisticated location finder.
The new Location finder is as follows
For a = 1 To 400
Dim SearchString As Variant
Dim SearchSymbol As String
SearchString = Cells(NewLastRowNumber, 10)
SearchSymbol = "€"
If InStr(1, SearchString, SearchSymbol, 1) = 0 Then
NewLastRowNumber = NewLastRowNumber - 1
Else
NewLastRowNumber = NewLastRowNumber + 1
Exit For
End If
Next a
This works, apart from the what it searches within the cell. The ideal behind is it search a column of data containing cost, i.e (Row 1 -> €100, Row 2 -> €235 etc..) and find the last cell containng € currently I can only ever get it to find the column header and not the cell.
Each cell in the column is formatted as a Custom (€0.00), not sure if this makes any difference or not.
Ive embeded some images to further demonstrate my issue.
At this point NewLastRowNumber = 13
At this point the loop should break and record NewLastRowNumber = 13 but instead it continues until it finds the column header.
Hope this all makes sense & thanks.
The cell is formatted as Currency or Custom, thus you cannot find the Euro sign there. When you check InStr(), it checks the cell .Value, not the .Format.
To find the Eur in the Cell, check the format like this:
If Cells(NewLastRowNumber, 10).NumberFormat = "€0.00" Then
To see the exact number format in VBA, select the cell with the wanted format and run the following:
Sub Test()
Debug.Print Selection.NumberFormat
End Sub

Excel - Retrieve list of column names with cells containing >0 in one row

I have a huge spreadsheet of bird species sighting data, each column name is the name of a species and each row in column A is a number associated with a geographical location where the species count was taken. so each cell under each species is a count of how many times it was seen at its respective location.
What I want is a function that will give me a list of column names that had values >0 at that location. Everything I've found has shown me how to find the first value >0 but I want a list that could contain like 50 species names.
The idea at the end is that for each geographical point I just have a list of species that have been seen there. I'm assuming the function would start with INDEX from what I've read but not sure how to proceed.
If VBA is the only way forward, that's fine but I am very new to it so suggestions on what would accomplish this would be welcome.
As #Jeeped gave in the comment above, here is the answer adapted to your situation, from his post of the linked answer.
Since you are handling 50 columns, the handling is creating a VBA User Defined Function.
This is how you create one:
Press Alt+F11.
When the VBE opens, in the menus select Insert ► Module (Alt+I,M).
Paste the following into the window.
Public Function conditional_concat(rSTRs As Range, rCRITs As Range, Optional sDELIM As String = ", ")
Dim c As Long, sTMP As String
For c = 1 To Application.Min(rSTRs.Cells.Count, rCRITs.Cells.Count)
If CBool(rCRITs(c).Value2) Then _
sTMP = sTMP & rSTRs(c).Value & sDELIM
Next c
conditional_concat = Left(sTMP, Application.Max(Len(sTMP) - Len(sDELIM), 0))
End Function
Save the workbook.
Now you can use this function in the formula for the cells on your worksheet.
In your case, add the following into the second row in the "species found" column (BB is being your last column of species):
=conditional_concat(A$1:BB$1, A2:BB2)
Then you can copy-paste this on the rest of the rows.
Consider this User Defined Function:
Public Function Headerr(rIN As Range) As String
Dim r As Range
Headerr = ""
For Each r In rIN
If r.Value > 0 Then Headerr = Headerr & "," & r.EntireColumn.Cells(1).Value
Next r
If Headerr <> "" Then Headerr = Mid(Headerr, 2)
End Function
For example:
This example uses only five columns, but that is not a limit.
User Defined Functions (UDFs) 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 UDF 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 UDF:
bring up the VBE window as above
clear the code out
close the VBE window
To use the UDF from Excel:
=myfunction(A1)
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
and for specifics on UDFs, see:
http://www.cpearson.com/excel/WritingFunctionsInVBA.aspx
Macros must be enabled for this to work!

How to find if cell contains specific characters in specific positions?

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.