I have a long excel list (+10k rows) and a column with ordernumbers.
Unfortunatelly some orders were deleted.
My question is simple but to achieve probabily not: I want to count the deleted rows, basically the missing ordernumbers.
A hint is aprechiated.
endo
I don't know how to do this using Excel code, but if you go to the bottom and get the last order number, you can calculate how many there should be with
last order number - first order number = expected amount
How many their actually are would be
last order index - first order index = actual amount
Then you can do
expected amount - actual amount = missing order numbers
Of course, this assumes there are no blank rows between order numbers, and that you only need to do this once. (you prob want a function or something to have it update as you change the spreadsheet)
This covers blank rows and numbers missing from the sequence (however, if your min/max are deleted, this can't detect that). It's similar to #shieldgenerator7's answer.
No sorting necessary for this.
EDIT: As sheildgenerator7 pointed out, this assumes that you expect all of your order numbers to be sequential.
=(MAX(A2:A26)-MIN(A2:A26)+1)-COUNTA(A2:A26)
You can now count blanks in Excel with a simple function called COUNTBLANK. If you know the ending row number (for example, if the data were in A1 to A10000), you can use this formula:
=COUNTBLANK(A1:A10000)
If the numbers are sequential it is pretty easy.
Sort by order number
Count in B4
=(A4-A3)-1
Sum in B17
=SUM(B3:B16)
Here's something I put together to identify missing numbers and optionally print the list out on a new workbook.
You can change the minimum and maximum number, and it does not matter if the list is sorted or not.
Sub FindMissingNumbers()
Dim lstRange As Range
Dim r As Long
Dim lowestNumber As Long
Dim highestNumber As Long
Dim missingNumbers() As Variant
Dim m As Long
Dim wbNew As Workbook
'## Set this value to the lowest expected value in ordernumber'
lowestNumber = 0
'## Set this value to your highest expected value in ordernumber'
highestNumber = 100
'Assuming the order# are in column A, modify as needed:'
Set lstRange = Range("A1", Range("A1048576").End(xlUp))
For r = lowestNumber To highestNumber
'## Check to see if this number exists in the lstRange
If IsError(Application.Match(r, lstRange, False)) Then
'## Add this number to an array variable:'
ReDim Preserve missingNumbers(m)
missingNumbers(m) = r
m = m + 1
End If
Next
If MsgBox("There were " & m & " missing order numbers" _
& vbNewLine & "Do you want to print these numbers?", vbYesNo) = vbYes Then
Set wbNew = Workbooks.Add
With wbNew.Sheets(1)
' For r = LBound(missingNumbers) To UBound(missingNumbers)
' .Range("A1").Offset(r, 0).Value = missingNumbers(r)
' Next
.Range("A1").Resize(UBound(missingNumbers) + 1) = _
Application.WorksheetFunction.Transpose(missingNumbers)
End With
Else:
End If
End Sub
Related
I'm kinda new here, but here is what I'm trying to do.
I have a book lets pretend its a warehouse book for inventory, and we have different divisions in our enterprise, I have master sheet with all the goods and some sheets covering those divisions for distribution of goods between them.
My idea is to have a drop down list for each item type in book for separate divisions so i need macro to assign/reassign named range for each item.
I have 2 columns first with stock number and second with serial number , i need to put all the same serial number in the named range of one of stock numbers. if i have two or more serial numbers i need to put an array of serial numbers in named range of one stock number.
Stock numbers are in C column and serial numbers are in D column
I've tried this code
Private Sub CommandButton2_Click()
Dim LastRow As Long
Dim r As Range
LastRow = Cells(Rows.Count, "C").End(xlUp).Row
For Each r In Range("C2:C" & LastRow)
Range(r.Offset(0, 1), r.Offset(0, 1)).Name = r.Value
Next r
End Sub
But thats not realy working, and assigns only one serial number per one named range of stock numbers
================================================================
So i ran this code you proposed in your updated version and struck some problems
Private Sub CommandButton2_Click()
Dim this As Worksheet: Set this = Sheets("ALFA")'renamed this for my book'
Dim that As Worksheet: Set that = Sheets("STORAGE")'renamed that for my book'
serialNumbers = that.Range(that.Columns(3), that.Columns(4))'Could not find method Unique(and there is no mentions about'
'it in MS documentation) for Application object so i changed it to just Range'
For r = 2 To this.UsedRange.Rows.Count
buffer = ""
comma = ""
stockNumber = this.Cells(r, 3)
For x = 2 To UBound(serialNumbers)
If serialNumbers(x, 1) = stockNumber Then
buffer = buffer & comma & serialNumbers(x, 2)
comma = ","
End If
Next
this.Cells(r, 4).Validation.Delete
this.Cells(r, 4).Validation.Add _'After doing everything it strucks with Run time error 1004
Type:=xlValidateList, _ '/Application-defined or object-defined error in this
AlertStyle:=xlValidAlertStop, _'hole'
Formula1:=buffer 'block'
Next
End Sub
And sometimes code just hangs my excel application for atleast 3 mins, i think it's because there is no limit for cells to look up to and eventualy it tries to give all the cells in D:D a validation check
So if you want to set the validation, it is possible to set dynamic ranges BUT the validation won't accept a text list, for instance "one, two, three". The validation is looking for an array of values, and unfortunately it is tricky to pass a dynamic array using formulas only. You can set it up to do a dynamic range, but that would have to point to a range of cells that contain the needed values one per cell.
However, before you set all that up it's probably just easier to set the validation entirely in code. See this google sheet, which just contains the layout for reference. I have the complete list of items in Column 1 & 2 of the sheet (Item, Stock Number) and the complete list of serial numbers in columns 5 & 6 (Stock Number, Serial Number).
Then I run this code:
Sub setValidation()
Dim this As Worksheet: Set this = Sheets("demo")
Dim that As Worksheet: Set that = Sheets("lookups")
serialNumbers = Application.Unique(that.Range(that.Columns(5), that.Columns(6)))
For r = 2 To this.UsedRange.Rows.Count
buffer = ""
comma = ""
stockNumber = this.Cells(r, 3)
For x = 2 To UBound(serialNumbers)
If serialNumbers(x, 1) = stockNumber Then
buffer = buffer & comma & serialNumbers(x, 2)
comma = ","
End If
Next
this.Cells(r, 4).Validation.Delete
this.Cells(r, 4).Validation.Add _
Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Formula1:=buffer
Next
End Sub
We assign some worksheet variables to make it easier to reference them, and then put the stock number/serial number combos into an array (with UNIQUE so I don't have to check for duplicates).
Then I run through the range that needs the validations (demo column 4), getting the stock number from column 3 and then using that stock number to find all serial numbers that match, concatenating them into a string and then using that string to set the validation.
Use Validation.Delete before setting the validation to avoid stacking rules.
Assuming that your version of Excel doesn't have UNIQUE, you can use INTERSECT to control the size of the serialNumbers array, like this:
Sub setValidation()
Dim this As Worksheet: Set this = Sheets("demo")
Dim that As Worksheet: Set that = Sheets("lookups")
serialNumbers = Intersect( _
that.Range(that.Columns(5), that.Columns(6)), _
that.UsedRange _
)
For r = 2 To this.UsedRange.Rows.Count
buffer = ""
comma = ""
stockNumber = this.Cells(r, 3)
For x = 2 To UBound(serialNumbers)
If serialNumbers(x, 1) = stockNumber Then
buffer = buffer & comma & serialNumbers(x, 2)
comma = ","
End If
Next
this.Cells(r, 4).Validation.Delete
this.Cells(r, 4).Validation.Add _
Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Formula1:=buffer
Next
End Sub
Assuming you do have UNIQUE and FILTER in your Excel version, there is another way to do it, using the EVALUATE function to access the Excel function engine. In this case we will just write out a formula just like we would in a cell, and then evaluate it from VBA. Unless specified, evaluate occurs in the context of the active sheet, so that's what I use that.evaluate in this code:
Sub setValidation()
Dim expr As String
Dim this As Worksheet: Set this = Sheets("demo")
Dim that As Worksheet: Set that = Sheets("lookups")
For r = 2 To this.UsedRange.Rows.Count
stockNumber = this.Cells(r, 3)
expr = "Textjoin("","", true, Unique(Filter(F:F, E:E=""" & stockNumber & """)))"
serialNumbers = that.Evaluate(expr)
this.Cells(r, 4).Validation.Delete
this.Cells(r, 4).Validation.Add _
Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Formula1:=serialNumbers
Next
End Sub
In this case, we use FILTER to return ONLY the serial numbers that match a stock number, UNIQUE to make sure there are no duplicates, and then TEXTJOIN to create a list from that, and then we can just pass that result straight to the validation.
===================================================
Original answer, shows how to get a list of all serial numbers for a specific stock number using only excel formulas, but it became clear that this wouldn't be sufficient, since the lists were going to be used to set validation. Left here for completeness.
So you have two columns, C and D, and you need to get a list of all values in D that match the entries in C. This is actually simple enough to not need code, but you may have more requirements. I'm going to start an answer with just a very basic set of formulas. See this google sheet.
To get a unique list of the stock numbers, I have used UNIQUE(C:C) in G1. This will produce the list in column G.
Then in column H, I have used TEXTJOIN+UNIQUE+FILTER to produce a comma separated list of serial numbers. FILTER takes one input array (in this case Col D) and filters it with another array (Col C) and a condition (the serial number) to return a list of matches, and wrapping that in UNIQUE makes sure that the result array contains only unique values. Wrapping that in TEXTJOIN converts the result array into text.
What I'm not entirely clear on is your need for a named range, or what you will do with the multiple rows in a sheet. For instance, STORAGE rows 35 & 36 are both for DDG_33:
DDG_33 0BV1111
DDG_33 0AV0951
and if you ran some code to produce a list of values and put it in D35 you would have:
DDG_33 0BV1111, 0AV0951
DDG_33 0AV0951
but you would still have two entries for DDG_33. If you ran the code again, you would have
DDG_33 0BV1111, 0AV0951, 0AV0951
DDG_33 0AV0951
and so forth in an infinite loop. It seems like you would need to take the list of unique stock numbers and put them on a different sheet, along with the list of matching serial numbers, but just clarify what you want to do and I can update my answer.
Right - this is a tricky one to phrase so I'm going to use a couple of images to help me.
In Columns A and B is a varying list of team names and the number of players each team has.
Column D contains the desired output.
I need a formula, to be inserted into Cell D2 and dragged down as far as the total of Column B, to return the team names - but crucially to allow a number of rows beneath which return blank. The number of blank rows beneath is effectively equal to 1 - the number of players in that team.
I have given it some thought, but can't come up with a suitable formula. Any ideas?
Also suggestions for a better title are welcome.
The following VBA function will do exactly what you want. Let me know if any part of it is not clear to you.
Sub teamRows()
Dim colDRowNumber As Integer
Dim i As Integer
Dim teamName As String
Dim numberOfRows As Integer
Dim HowFar As Integer
' Loop through the teams in column A
HowFar = Application.WorksheetFunction.CountA(Range("A:A"))
' Variable to keep count of rows in column D
colDRowNumber = 2
For i = 2 To HowFar
' Get the team's name and number of rows
teamName = Range("A" & i).Value
numberOfRows = Range("B" & i).Value
' Fill in the team's name in column D
Range("D" & colDRowNumber).Value = teamName
' Increase the row number by the number of empty rows required
colDRowNumber = colDRowNumber + numberOfRows
Next i
End Sub
A complex but short attempt - I wanted to avoid loops.
Example below works on A2 to A20
y = Split(Join(Application.Transpose(Application.Evaluate("=index(substitute(substitute(substitute(REPT(A2:A20 &"","",B2:B20),A2:A20&"","",""X"",1),A2:A20,""""),""X"",A2:a20),0,1)")), ","), ",")
[d2].Resize(UBound(y)) = Application.Transpose(y)
I am working on algorithm base tool; Kindly assist me for below problem.
1.First I find row number based on one criteria (Dynamic). Assume row number is 5 and it has set of Value From (B5:F5)
Set FindRow = SearchRange.Find(Sheet1.Cells(xRow, 2).Text, LookIn:=xlValues, lookat:=xlWhole)
MyRow = FindRow.Row
2.I have header with numeric value(B1:F1)
3.Then I need to find column number, ie MyCol is column number of minimum value cell in (B1:F1)
4.Then I test one criteria with If Cells(MyRow,MyCol)="ABC" Then test fail and again I need go and find next Minimum value in (B1:F1) and column number, ie MyCol, Until I Meet the condition.
I tried array, I am not able to find solution, Any help would be much appreciated. My Thanks in advance.
If I understand correctly, what you need is an indexed sort. Many languages provide an indexed sort as a standard function. VBA has neither a sort nor an indexed sort as standard.
With a conventional array sort, values are sorted within the array. For example: suppose I have an array with values:
A D B E C
If I pass that array to a sort, it is returned as:
A B C D E
But sometimes you cannot sort the array. In your case, the array is a range of column headings. You cannot sort those headings because they belong with their columns. You would have to sort the columns which is at best impractical and probably unacceptable since the sequence of columns will mean something.
With an indexed sort, you create arrays Keys and Indices:
Keys A D B E C
Indices 1 2 3 4 5
Both these arrays are passed to the sort which leaves Keys unchanged and sorts Indices to give:
Indices 1 3 5 2 4
With the regular sort, you access the sorted entries as Array(1). Array(2) and so on. With an indexed sort, you access the sorted entries as Array(Indices(1)). Array(Indices(2)) and so on.
Going via an index to get the sorted entries can be a little difficult to understand at first and it is undoubtedly fiddlier that going directly to the source array.
Below I have given you an indexed Insertion Sort. An Insertion Sort is simple and easy to understand but is slow with large numbers of entries. You only have five entries to sort so its performance is acceptable. Look at the Wiki entry for "Insertion Sort" for a pictorial demonstration of how it works.
Macro DemoSortColumnHeadings shows how to use the sort and how to access the column headings. I have used the name ColHeads instead of Keys and ColNums instead of Indices because I believe this will make DemoSortColumnHeadings easier to understand. The sorted ColNums contains the column numbers in the sequence you require. After the sort, the array ColHeads is no longer required.
One last point. VBA is the only language I know which allows you to specify both the lower bound and the upper bound of an array. Most languages require the lower bound to be zero. I have taken advantage of this to define the dimensions of the arrays as (2 to 6) and not (0 to 4). This is why the values in array ColNums are column numbers. With most languages, I would have needed ColNums(N)+2 to get the column number.
Option Explicit
Sub DemoSortColumnHeadings()
Const ColFirst As Long = 2 ' Column B = column 2
Const ColLast As Long = 6 ' Column F = column 6
Dim ColCrnt As Long
Dim ColNums() As Long
Dim InxColNum As Long
Dim ColHeads() As String
With Worksheets("Test data")
ReDim ColHeads(ColFirst To ColLast)
ReDim ColNums(ColFirst To ColLast)
For ColCrnt = ColFirst To ColLast
ColHeads(ColCrnt) = .Cells(1, ColCrnt).Value
ColNums(ColCrnt) = ColCrnt
Next
Debug.Print "Initial sequence"
Debug.Print "|";
For ColCrnt = ColFirst To ColLast
Debug.Print .Cells(1, ColCrnt).Value & "|";
Next
Debug.Print
Call InsertionSort(ColNums, ColHeads)
Debug.Print "Final sequence"
Debug.Print "|";
For InxColNum = LBound(ColNums) To UBound(ColNums)
ColCrnt = ColNums(InxColNum)
Debug.Print .Cells(1, ColCrnt).Value & "|";
Next
Debug.Print
End With
End Sub
Public Sub InsertionSort(ByRef Indices() As Long, ByRef Keys() As String)
Dim Found As Boolean
Dim I As Long
Dim InxIFwd As Long
Dim InxIBack As Long
For InxIFwd = LBound(Indices) + 1 To UBound(Indices)
I = Indices(InxIFwd) ' Save value of current entry in Indices
' Find first entry back, if any, such that Keys(I) >= Keys(Indices(InxIBack))
' If Keys(I) < Keys(Indices(InxIBack)), set Indices(InxIBack+1) to
' Indices(InxIBack). That is move indices for keys greater that Keys(I) down
' Indices leaving a space for I nearer the beginning.
Found = False
For InxIBack = InxIFwd - 1 To LBound(Indices) Step -1
If Keys(I) >= Keys(Indices(InxIBack)) Then
' Keys(I) belongs after Keys(Indices(InxIBack))
Indices(InxIBack + 1) = I
Found = True
Exit For
End If
Indices(InxIBack + 1) = Indices(InxIBack)
Next
If Not Found Then
' Insertion point for I not found so it belongs at beginning of Indices
Indices(LBound(Indices)) = I
End If
Next
End Sub
I would like to ask your help to resolve an issue I'm facing building an algorithm.
Available data
We have a table of data with 10 rows and 30 columns.
Each row corresponds to the variable linkied to a specific parameter (for example weight of Apples, weight of Pears,weight of Oranges... Paramter10)
Each column corresponds to the value the variable can take.
This how we have 30 possible values for each variable/parameter.
Goal of the algorithm
Give the sum of all possible combinations of these parameters (Apples+Pears+ Oranges+...+Paramter10), normally there should be 30^10 possible combinations
Description of my version of the algorithm
It is to create an array of 10, let's say, indexes. Each index is corresponding to the variable/parameter. Each index is filled by one out of 30 possible values.
Create a loop passing through the columns in the same row. Each value of the cell in the table is placed in the corresponding index (row 1, for index 1)
Each change corresponds to the next available value (on the right) in the same row but with a different column. While the column is terminated, the algorithm starts to do the same for the next row.
Every change in the array varlues has to give as result a new sum, copied in a new cell somewhere in the table.
Sub AlgoSum()
Dim rw As Long, column1 As Long
Dim Sum1(9) As Long 'The array with 10 index 'First difficulty is to find a way how to synchornize the sum with every change in array Sum1.
Do While i <= 8 'My version is to place it in first but not sure it is right
For rw = 1 To 9
For column1 = 1 To 30
If Not IsEmpty(Worksheets("Sheet1").Cells(rw, column1)) Then 'verify that the cell is not empty
Sum1(i) = Worksheets("Sheet1").Cells(rw, column1).Value
Worksheets("Sheet1").Cells(rw+30, column1+30).Value = Application.WorksheetFunction.Sum(Sum1)
Else 'normally if it is empty it should move to the next value but I didn't find the appropriate way to do it, this why I thought about this compromise
Sum1(i) = 0
Worksheets("Sheet1").Cells(rw+30, column1+30).Value = Application.WorksheetFunction.Sum(Sum1)
End If
Next column1
Next rw
i = i + 1
Loop
End Sub
This code is not giving the appropriate results. It's not giving the sum for every change in the array, and it's not making the change in the array in the way it has to.
I've seen possible solution with a recursive, but didn't find the right way to do it.
Some help is very welcome!
Thank you in advance!
Try this. It's recursive (although it does use a loop as well).
Use the constants at the top to adjust to your data.
Try it with a few rows and a few columns.
The current constants assume that your data starts in cell A1, and that there are 3 "variables" and 2 "values".
It will print the results to the immediate window as it goes, but you could certainly adjust it to store in an array or print to another sheet.
' number of "variables"
Const ROWS As Integer = 3
' number of "values"
Const COLS As Integer = 2
' upper left cell of table
Const CELL_UPPER_LEFT As String = "A1"
' Recursive method to sum the values of all the combinations of all the rows.
' Method will print the result in the immediate window for now.
' #param row_number Integer Number of rows of data
' #param sum Double Running sum of previous rows
Private Sub recursiveSum(ByVal row_number As Integer, ByVal sum As Double)
' if we've reached the bottom, then print the result and go back up
If row_number = ROWS Then
Debug.Print sum
Exit Sub
End If
' loop over the number of columns
Dim col_number As Integer
For col_number = 0 To COLS - 1
' make a recursive call, increasing the sum by the current row and increasing the row number by 1
recursiveSum row_number + 1, Range(CELL_UPPER_LEFT).Offset(row_number, col_number).Value + sum
' when we return from the recursive call we will be here - ready to start the next time through the loop
Next
End Sub
' Wrapper function for the recursive method.
Public Sub recursiveSumWrapper()
' make the initial recursive call
recursiveSum 0, 0
End Sub
Thank you really for your reply. Your solution is working perfectly with debug.print!
I was able to add an automatic dimensioning of the table:
' number of "variables"
Dim ROWS As Integer
' number of "values"
Dim COLS As Integer
' upper left cell of table
Const CELL_UPPER_LEFT As String = "A1"
ROWS = Worksheets("Sheet1").UsedRange.ROWS.Count
COLS = Worksheets("Sheet1").UsedRange.Columns.Count
a = (ROWS) ^ (COLS) 'The number of possible combinations
However I spent all the morning to change debug.print for another option:
If row_number = ROWS Then
Debug.Print sum
Exit Sub
End If
For a more convenient possibility for the following use of obtained data
If row_number = ROWS Then
For i = 1 To a
Worksheets("Sheet2").Cells(20, a).Value = sum
Exit Sub
Next
End If
As I understand, it's not the right place to use a loop, because I get the error: «Subscript out of range». My intuition is telling me it's ROWS which doesn't correspond to a.
Do you have any idea about this detail? Is it possible to use debug.print information directly?
I am trying to compare two data series with dates and on a third column show ONLY the dates that are common in both data series (ordered in descending mode). A friend of mine helped me put together some code that seems to work but it seems to be taking a long time to generate the result when I have quite a long series of data. Is there a way to write this code differently that might get calculated faster? (I am currently using excel 2010.
The Function I enter on D2 and then I copy it down is: =next_duplicate(A2:$A$535,B2:$B$535,D1:$D$1)
Function next_duplicate(list1, list2, excluded)
For Each c In list1
If WorksheetFunction.CountIf(excluded, c) = 0 Then
If WorksheetFunction.CountIf(list2, c) > 0 Then
next_duplicate = c
Exit For
End If
End If
Next c
If next_duplicate = 0 Then
next_duplicate = "N/A"
End If
End Function
You can do this without VBA.
In Column C use COUNTIF to extract dates that appear only in both Columns A and B
=IF(COUNTIF($B$2:$B$7,"="&A2) > 0, A2, 0)
Then in Column D use an array formula (from here) to sort and remove blanks. Don't forget to select the range and then press control, shift and enter.
=INDEX(C2:C7, MATCH(LARGE(IF(ISBLANK(C2:C7), "", IF(ISNUMBER(C2:C7), COUNTIF(C2:C7, "<"&C2:C7), COUNTIF(C2:C7, "<"&C2:C7)+SUM(IF(ISNUMBER(C2:C7), 1, 0))+1)), ROW()-ROW($D$2)+1), IF(ISBLANK(C2:C7), "", IF(ISNUMBER(C2:C7), COUNTIF(C2:C7, "<"&C2:C7), COUNTIF(C2:C7, "<"&C2:C7)+SUM(IF(ISNUMBER(C2:C7), 1, 0))+1)), 0))
If #Dan's solution works, go with that since formula solutions are usually cooler :) If you need to use VBA, you can try this:
Sub Common()
Dim Date1 As Range
Dim Date2 As Range
Dim CommonDates() As Variant
Dim UniqueDates As New Collection
Set Date1 = Range("A2:A6")
Set Date2 = Range("B2:B6")
' Change the max array size to equal the length of Date1
' This is arbitrary and could be more efficient, for sure :)
ReDim CommonDates(Date1.Count)
' Set a counter that will increment with matches
i = 0
' Since a match needs to be in both, iterate through Date1 and check
' if the Match function returns a True value when checking Date2.
' If so, add that value to the CommonDates array and increment the counter.
For Each DateVal In Date1
If IsError(Application.Match(DateVal, Date2, 0)) = False Then
CommonDates(i) = DateVal.Value
i = i + 1
End If
Next
' Filter out dupes (in case that is possible - if not, this can be removed
' and the bottom part reworked
On Error Resume Next
For Each Value In CommonDates
UniqueDates.Add Value, CStr(Value)
Next Value
' Now go to the first cell in your Common Dates range (I'm using C2) and
' print out all of the results
Range("C2").Activate
For j = 1 To UniqueDates.Count
ActiveCell.Value = UniqueDates(j)
ActiveCell.Offset(1).Activate
Next j
' Back to the beginning
Range("C2").Activate
' Use this if you don't need to filter dupes
'For Each r In CommonDates
' ActiveCell.Value = r
' ActiveCell.Offset(1).Activate
'Next
End Sub
It basically iterates over Date1 and checks if the Match formula succeeds/fails in Date2. A success = match, which means a common date. Those are then printed to another column. Hope this helps!