EDIT, in short:
I have an excel table that looks like this:
tabel
Each cell contains a range of numbers.
I'm looking for a function that can search for a number in the whole table and indicate me the column and row where the range that it belongs to is located.
So, if I search for number 2346, it should function like this:
function (2346) > result (C1, R2)
I have a huge archive of photos (about 300.000 items) in a library.
Photos are stored in boxes, the boxes in shelves.
Each box has a range of inventory numbers of photos.
I want to create a map of the deposit that looks like this:
Shelf 1 - contains boxes 1, 2, 3, etc.
Box 1 - contains photos with inventory numbers between 1257-1321
Box 2 -"- between 2345-2522
Box 3 -"- between 123523-123643
Translated in an excel table, it would look like this:
Column 1 would be Shelf 1, containing the boxes with the images:
cell in column 1 / row 1 (that's box 1) contains the range of numbers: 1257-1321
cell in column 1 / row 2 (box 2), the range: 2345-2522
cell in column 1 / row 3 (box 3), range: 123523-123643
They are not in order, because they entered in more than 100 years in the collection, and they are arranged as they entered and by subject. Not to mention that the deposit has been moved a few times. So, I have a hard time to find one image when I'm looking for it.
But if I have this excel table, this map of the deposit, supposedly I want to enter the inventory number that I'm looking for, let's say "2346", and a formula that search throughout the whole table would indicate me that the item (number I look for, is in a range that is located in column 1, row 2, that means shelf one, box 2 in the deposit).
Actually the concept is very simple, excel is able to do MUCH more difficult tasks, and I'm amazed I can't find a way to do this. I'm a photographer and librarian, so my experience in programming is close to zero.
Thank you very much if you can help!
It's a bit of a lenghty one but not hard to understand, I made some sample data like so:
="C"&SUMPRODUCT(((VALUE(LEFT($A$1:$B$3,SEARCH("-",$A$1:$B$3)-1))<=D3)*(VALUE(RIGHT($A$1:$B$3,LEN($A$1:$B$3)-SEARCH("-",$A$1:$B$3)))>=D3))*COLUMN($A$1:$B$3))&", "&"R"&SUMPRODUCT(((VALUE(LEFT($A$1:$B$3,SEARCH("-",$A$1:$B$3)-1))<=D3)*(VALUE(RIGHT($A$1:$B$3,LEN($A$1:$B$3)-SEARCH("-",$A$1:$B$3)))>=D3))*ROW($A$1:$B$3))
Youll just have to change ranges
If you set up your worksheet like the image below (sheet name "Library"):
You could try the code:
Option Explicit
Sub Painting()
Dim LastRow As Long, i As Long, SearchValue As Long
Dim arrData As Variant
'Let s say that all data appears in sheet called Library
With ThisWorkbook.Worksheets("Library")
'Let s say that we are looking for the value in cell H1
SearchValue = .Range("H1").Value
'Find the Last row of column A sheet Library
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'Create as array from Column A row 2 up to Column D row LastRow
arrData = .Range(.Cells(2, 1), .Cells(LastRow, 4)).Value
'Loop Array to find a match
For i = LBound(arrData) To UBound(arrData)
If arrData(i, 3) <= SearchValue And arrData(i, 4) >= SearchValue Then
'Pop up with Shelf & Box name
MsgBox "Search Value " & SearchValue & " included in:" & vbNewLine & "Shelf: " & arrData(i, 1) & vbNewLine & "Box: " & arrData(i, 2)
'Select the line where the Search Value found
.Range("A" & i + 1 & ":D" & i + 1).Select
'Exit the loop
Exit For
End If
Next i
End With
End Sub
Result:
Related
I am relatively new to Macros and VBA in Excel, so I need some guidance on how to solve my current issue.
The end goal of my project is to have a macro compare two sets of data organized into rows and columns (We'll say table A is the source data, and table B is based off of user input). Each row in table B should correspond to a row in table A, but they could be out of order, or there could be incorrect entries in table B.
My thought is that for the first row in each table, the macro would compare each cell left to right:
If Sheets("sheet1").Cells(2, 1) = Sheets("sheet2").Cells(2, 1) Then
If Sheets("sheet1").Cells(2, 2) = Seets("sheet2").Cells(2, 2)
Ect, ect.
My problem comes in when the Cell in table B does not match Table A.
First, I would want it to check B row 1 against the next row in A, and keep going throughout table A until it finds a "complete match" with all five columns of the row matching.
I've been trying to do this with Else if and For/Next staements
For row= 2 to 10
'if statements go here
Else If Sheets("sheet1").Cells(2, 1) <> Sheets("sheet2").Cells(2, 1)
Next row
I may be completely misunderstanding the syntax here, but I have yet to produce a situation where if the criteria is not met, it goes to the next row.
If no complete match is found, the last cell in table B row 1 that couldn't be matched should be highlighted.
Then regardless of whether a match was found or not, we would move to table B row 2, and start the whole process over.
So, I have the logic worked out (I think), where the comparison ifs would be inside a loop (or something) that would cycle through table A row by row. Then that whole process would be in another loop (or something) that would cycle through Table B.
At the end of the process, there would either be no highlighted cells showing that all entered data is correct, or cells would be highlighted showing data that do no match.
I am fairly certain that the cycling through table B is not the issue. Rather, I'm having difficulty getting the Macro to move to the next table A row if something doesn't match.
Please let me know if I need to elaborate on anything.
Thanks!
You could try:
Option Explicit
Sub test()
Dim Lastrow1 As Long, Lastrow2 As Long, i As Long, j As Long
Dim Str1 As String, Str2 As String
'Find the last row of sheet 1
Lastrow1 = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
'Find the last row of sheet 2
Lastrow2 = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row
For i = 2 To Lastrow1
'Let us assume that table has 3 columns. Merge 3 columns' values and create a string for each line
Str1 = Sheet1.Cells(i, 1).Value & "_" & Sheet1.Cells(i, 2).Value & "_" & Sheet1.Cells(i, 3).Value
For j = 2 To Lastrow2
'Let us assume that table has 3 columns. Merge 3 columns' values and create a string for each line
Str2 = Sheet2.Cells(j, 1).Value & "_" & Sheet2.Cells(j, 2).Value & "_" & Sheet2.Cells(j, 3).Value
'If both strings match a message box will appear
If Str1 = Str2 Then
MsgBox "Line " & i & " in table A match with line " & j & " in table B!"
Exit For
End If
Next j
Next i
End Sub
Sheet 1 structure:
Sheet 2 structure:
I have a spreadsheet with a load of random text and numbers in column A like so:
Column A
Row 1 = 471806121601 5205569 - 0007 Standard White Toilet Tissue 27
Row 2 = 471814121601 5206177 - 0014 Premium White Toilet Tissue 6
Row 3 = 471814121601 5206178 - 0007 Premium White Toilet Tissue 27
Row 4 = 471806121601 5206180 - 0014 Premium Kitchen Towel 2x75l 6
I have about 2000 lines in total. In each cell, is a Purchase order number (12 digits) and an item number next to it (7 digits).
I am trying to extract the po number and put it into column B and extract the item number and put it into column C
Column B Column C
471806121601 5205569
471814121601 5206177
471814121601 5206178
471806121601 5206180
Here is my code:
Option Explicit
Sub main()
Dim cell As Range
Dim arr As Variant, arrElem As Variant
With Worksheets("Orders") '<--| change "Strings" to your actual worksheet name
For Each cell In .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
arr = Split(Replace(cell.Value, " ", " "), " ") '<--| change "A"'s to your actual relevant column index
For Each arrElem In arr
If IsNumeric(arrElem) Then
If Len(arrElem) = 12 Then cell.Offset(0, 1).Value = arrElem
End If
Next arrElem
Next cell
End With
Dim cell2 As Range
Dim arr2 As Variant, arrElem2 As Variant
With Worksheets("Orders") '<--| change "Strings" to your actual worksheet name
For Each cell2 In .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
arr2 = Split(Replace(cell2.Value, " ", " "), " ") '<--| change "A"'s to your actual relevant column index
For Each arrElem2 In arr2
If IsNumeric(arrElem2) Then
If Len(arrElem2) = 7 Then cell2.Offset(0, 3).Value = arrElem2
End If
Next arrElem2
Next cell2
End With
End Sub
This code does work. However it takes absolutely ages and only does one line at a time...Slowly.
Is there a quicker way of doing this? Thanks
If your PO and IN are always the same length in col B put
=MID(A2, 1, 12)
And in col C
=MID(A2, 14, 7)
However if your number change but are always the first two swap the above for,
=MID(A2,1,FIND(" ",A2,1)-1)
And
=MID(A2, FIND(" ", A2, 1)+1, 7)
Respectively.
just use split(string,delimiter)(0) and (1) why replace the space, just use that as the delim. If Row # is in, then use (1) and (2), or you could consider split(split(input,"-")," ") maybe a little faster, not sure though. Also, once you're done no need to complete the loop, so consider, do until with flags rather than for next, although exit for is available
Formula wise, it could be done using something like this
=MID(D1,FIND("é",SUBSTITUTE(D1," ","é",3)),FIND("é",SUBSTITUTE(D1," ","é",4))-FIND("é",SUBSTITUTE(D1," ","é",3)))
and
=MID(D1,FIND("é",SUBSTITUTE(D1," ","é",4)),FIND("é",SUBSTITUTE(D1," ","é",5))-FIND("é",SUBSTITUTE(D1," ","é",4)))
I have to average sets of 3 columns.
EXAMPLE:
Blood_Patient1_0_R1, Blood_Patient1_0_R2, Blood_Patient1_0_R3
There average is in a new column Blood_Patient1_0
Similarly, Blood_Patient1_3_5_R1, Blood_Patient1_3_5_R2, Blood_Patient1_3_5_R3
The average is in a new column Blood_Patient1_3_5
This process is being repeated for 8 such sets of columns.
Currently I am averaging using the formula: IF(ISERROR(AVERAGE(B7:D7)),"",AVERAGE(B7:D7)) and auto-filling 21,000 plus rows.
Since there is a pattern in column headings, I was thinking to automate the whole process.
This is what I have thought so far in terms of algorithm:
0, 3_5, 6_25 are time values in column headers.
at each time instant, there are 3 replicates R1, R2,R3 as part of column headers
for time array [3.5h, 6.25h, 9.5h, 11.5h, 16.5h, 25h, 49h, and 156h
]
create a new column
for rows from 2 to 21458
average over replicates from R1 to R3 using above formula
I do not know how to write this in excel. Any help would be appreciated.
Give this a go.
This solution assumes that you have a continuous data set, that is, no gaps between the columns you wish to search through.
Firstly, you will need to include this function. Paste it into the same module as the subroutine. The purpose of this function is to allow the string in each heading to be compared against an array of substrings, as opposed to the single substring permitted by the InStr function.
Function Time_Search(strCheck As String, ParamArray anyOf()) As Boolean
Dim item As Long
For item = 0 To UBound(anyOf)
If InStr(1, strCheck, anyOf(item)) <> 0 Then
Time_Search = True
Exit Function
End If
Next
End Function
Next, paste in this subroutine. I have assummed that the dataset begins at cell A1. Also, I have allowed for a dynamic range, should the number of columns or rows ever change.
Sub Insert_Average_Columns()
Dim HeaderRange As Range
Dim LastRow As Long
Dim c As Range
Set HeaderRange = Range(Range("A1"), Range("A1").End(xlToRight))
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For Each c In HeaderRange.Cells
If Right(c.Value, 2) = "R3" Then
If Time_Search(c.Value, "3_5", "6_25", "9_5", "11_5", "16_5", "25", "49", "156") Then
c.Offset(0, 1).EntireColumn.Insert
c.Offset(0, 1) = "Average of " & Left(c.Value, Len(c.Value) - 3)
c.Offset(1, 1).FormulaR1C1 = "=IFERROR(AVERAGE(RC[-3]:RC[-1]),"""")"
c.Offset(1, 1).AutoFill Range(c.Offset(1, 1).Address, Cells(LastRow, c.Offset(1, 1).Column))
End If
End If
Next c
End Sub
There is one issue with your data. If you want the procedure to insert an average column for T = 25, then it will do so for all columns where T contains the string "25". If there are T= 8.25, 10.25, 15.25, etc, these will all have averages applied. The only way around it would be to include more of the heading string in the parameter array, but I presume you will be dealing with a variable Blood_Patient ID so that probably isn't an option.
Good afternoon all,
I have an issue where I have users who have multiple bank account details. I need to try and create a new row for each employee who has more than one bank account, with the second bank account being allocated a new row.
Employee Number User ID BSB Account number
10000591 WOODSP0 306089,116879 343509,041145273
10000592 THOMSOS0 037125 317166
I need it to look something like this:
Employee Number User ID BSB Account number
10000591 WOODSP0 306089 343509
10000591 WOODSP0 116879 041145273
10000592 THOMSOS0 037125 317166
Any thoughts? Your input is greatly appreciated!
Screenshots are here to demonstrate:
Right click on the tab and choose "View Code"
Paste this code in:
Sub SplitOnAccount()
Dim X As Long, Y As Long, EmpNo As String, UserID As String, BSB As Variant, AccNo As Variant
Range("F1:I1") = Application.Transpose(Application.Transpose(Array(Range("A1:D1"))))
For X = 2 To Range("A" & Rows.Count).End(xlUp).Row
EmpNo = Range("A" & X).Text
UserID = Range("B" & X).Text
BSB = Split(Range("C" & X).Text, ",")
AccNo = Split(Range("D" & X).Text, ",")
For Y = LBound(AccNo) To UBound(AccNo)
Range("F" & Range("F" & Rows.Count).End(xlUp).Row).Offset(1, 0).Formula = EmpNo
Range("G" & Range("G" & Rows.Count).End(xlUp).Row).Offset(1, 0).Formula = UserID
Range("H" & Range("H" & Rows.Count).End(xlUp).Row).Offset(1, 0).Formula = BSB(Y)
Range("I" & Range("I" & Rows.Count).End(xlUp).Row).Offset(1, 0).Formula = AccNo(Y)
Next
Next
End Sub
Close the window to go back to excel
Press ALT-F8
Choose SplitOnAccount and click run.
Note, this is going to populate the split data to rows F to I, make sure there is nothing in there. If there is post back and we can change it.
Also format columns F - I as text before you run it or Excel will strip leading zeros off as it will interpret it as a number.
Here is another sub that appears to perform what you are looking for.
Sub stack_accounts()
Dim rw As Long, b As Long
Dim vVALs As Variant, vBSBs As Variant, vACTs As Variant
With ActiveSheet '<-define this worksheet properly!
For rw = .Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
vVALs = .Cells(rw, 1).Resize(1, 4).Value
vBSBs = Split(vVALs(1, 3), Chr(44))
vACTs = Split(vVALs(1, 4), Chr(44))
If UBound(vBSBs) = UBound(vBSBs) Then
For b = UBound(vBSBs) To LBound(vBSBs) Step -1
If b > LBound(vBSBs) Then _
.Rows(rw + 1).Insert
.Cells(rw - (b > LBound(vBSBs)), 1).Resize(1, 4) = vVALs
.Cells(rw - (b > LBound(vBSBs)), 3).Resize(1, 2).NumberFormat = "#"
.Cells(rw - (b > LBound(vBSBs)), 3) = CStr(vBSBs(b))
.Cells(rw - (b > LBound(vBSBs)), 4) = CStr(vACTs(b))
Next b
End If
Next rw
End With
End Sub
I was originally only going to process the rows that had comma delimited values in columns C and D but I thought that processing all of them would allow the macro to set the Text number format and get rid of the Number as text error warnings and keep the leading zero in 041145273.
You Can definitely use Power Query to transform the data to generate new rows using split column option.
Check this article it explains the process in detail.
Load Data in Power Query section of excel.
Create an Index (Not required step)
Use Split column function with advance options and split them into new rows.
Save this result into new table for your use.
I did it myself and it worked like a charm.
A formula solution:
Delimiter: Can be a real delimiter or an absolute reference to a cell containing only the delimiter.
HelperCol: I have to use a helper column to make it work. You need to give the column letter.
StartCol: The column letter of the first column containing data.
SplitCol: The column letter of the column to be splitted.
Formula1: Used to generate the formula for the first column not to be splitted. You can fill this formula down and then fill to right.
Formula2: Used to generate the formula for the column to be splitted(only support split one column).
Formula3: Used to generate the formula for the Helper column.
(If the title of the column to be splitted contains the delimiter, you must change the first value of the helper column to 1 manually.)
Formula1:=SUBSTITUTE(SUBSTITUTE("=LOOKUP(ROW(1:1),$J:$J,A:A)&""""","$J:$J","$"&B2&":$"&B2),"A:A",B3&":"&B3)
Formula2:=SUBSTITUTE(SUBSTITUTE(SUBSTITUTE("=MID($M$1&LOOKUP(ROW(A1),$J:$J,F:F)&$M$1,FIND(""艹"",SUBSTITUTE($M$1&LOOKUP(ROW(A1),$J:$J,F:F)&$M$1,$M$1,"&"""艹"",ROW(A2)-LOOKUP(ROW(A1),$J:$J)))+1,FIND(""艹"",SUBSTITUTE($M$1&LOOKUP(ROW(A1),$J:$J,F:F)&$M$1,$M$1,""艹"",ROW(A2)-LOOKUP(ROW(A1),$J:$J)+1))-FIND(""艹"",SUBSTITUTE($M$1&LOOKUP(ROW(A1),$J:$J,F:F)&$M$1,$M$1,""艹"",ROW(A2)-LOOKUP(ROW(A1),$J:$J)))-1)&""""","$M$1",IF(ISERROR(INDIRECT(B1)),""""&B1&"""",B1)),"$J:$J","$"&B2&":$"&B2),"F:F",B4&":"&B4)
Formula3:=SUBSTITUTE(SUBSTITUTE(SUBSTITUTE("=SUM(E1,LEN(B1)-LEN(SUBSTITUTE(B1,$H$1,"""")))+1","B1",B4&1),"$H$1",IF(ISERROR(INDIRECT(B1)),""""&B1&"""",B1)),"E1",B2&1)
Helper must filled one row more than the data.
How to use:
Copy the formula generated by the above three formula.
Use Paste Special only paste the value.
Make the formula into effect.
Fill the formula.
Bug:
Numbers will be converted to Text. Of course you can remove the &"" at the end of the formula, but blank cells will be filled with 0.
ps. This method may by very hard to comprehend. But once you master it, it can be very useful to solve relative problems.
I'm working on problem that necessitates the use of nested formulas in excel. For eg:
I have a column for errors and one for its analysis
Error Analysis
Enter a valid material number Invalid Material
Eg errors:
Enter a valid material number; The material number 1234 does not
exist.
PO number XYZ does not exist.
VIN number 123 does not exist.
Country of origin AB does not exist.
I have a compendium of such errors and their analyis in the next sheet, and I'm using VLOOKUP in conjuction with FIND to lookup the analysis for the known errors.
=VLOOKUP(LEFT(F2, FIND(" ", F2, FIND(" ", F2) + 1) - 1)&"*", 'Sheet2'!A:B, 2, 0)
What i'm trying to do here is extract the first two words from the error and append a * to it and use it in VLOOKUP.
It would be something like Vlookup "PO number *" in the other sheet and get the analysis for it. Asterisk is because I don 't get the same number daily. And I also know that the extracted first two words of the error will be unique. (I know that error with "Enter a" as the first two words will not appear again).
Now I get errors in the same column so I thought of making a button and writing a code which uses the above formula.
I tried to modify some code off the net, but I'm not getting anywhere with it. I'm totally new to VBA. It'd be great if you can provide a snippet for this. I'll try to replicate the procedure for other needs.
This code seems to be working for now
Sub PopulateAnalysis()
Dim an_row As Long
Dim an_clm As Long
Dim lft As String
Dim st_num As Integer
Dim fin As String
Dim searchStr As String
Dim soughtStr As String
Table1 = Sheet1.Range("F2:F6") 'ErrorColumn from Error table (How do I make the range dynamic??)
Table2 = Sheet5.Range("A1:B6")
an_row = Sheet1.Range("G2").Row ' Populate this column from the analysis table on sheet2
an_clm = Sheet1.Range("G2").Column
For Each cl In Table1
'How do I translate the above formula into VBA statements??
st_num = InStr(InStr(cl, " ") + 1, cl, " ")
lft = left(cl, st_num - 1)
fin = lft & "*"
Sheet1.Cells(an_row, an_clm) = Application.WorksheetFunction.VLookup(fin, Table2, 2, True)
an_row = an_row + 1
Next cl
MsgBox "Done"
End Sub
This should work. You don't need the debug lines of course ;)
Sub PopulateAnalysis()
Dim rngTableWithErrors As Range
Dim rngTableWithAnalysis As Range
Application.ScreenUpdating = False
'set the range for Table with error, Table1 on sheet 1
With Sheets(1) 'change to name of the sheet, more reliable than index num.
Set rngTableWithErrors = .Range("F2:F" & .Cells(.Rows.Count, 6).End(xlUp).Row)
Debug.Print rngTableWithErrors.Address
End With
'set the range for Table with Analysis, Table 2 on sheet 2
With Sheets(2) 'change to name of the sheet, more reliable than index num.
Set rngTableWithAnalysis = .Range("A1:B" & .Cells(.Rows.Count, 2).End(xlUp).Row)
Debug.Print rngTableWithAnalysis.Address
End With
'formula for cell G2
'=VLOOKUP(LEFT(F2;FIND(" ";F2;FIND(" ";F2)+1)- 1)&"*";Sheet2!A1:B23;2; 0)
rngTableWithErrors.Offset(0, 1).FormulaR1C1 = _
"=VLOOKUP(LEFT(R[0]C[-1],FIND("" "",R[0]C[-1],FIND("" "",R[0]C[-1])+1)-1)& ""*"",Sheet2!R1C1:R" & rngTableWithAnalysis.Rows.Count & "C2,2, 0)"
Application.ScreenUpdating = True
MsgBox "Done"
End Sub
Notes
You can notice, that we are setting the upper left cells of ranges manually. It's better practice to somehow find the upper left cells (using Find method is my favorite) and work from there. You never know, how the user will change the worksheet - i.e. add new rows, columns etc.