I am trying to develop a mechanism where I can store all the values in 2D array for below table.
Below is the code that I have developed, just to store values.
Sub temp()
Dim QtyArray(4, 11) As Integer, rw As Integer, col As Integer
For rw = 0 To 4
For col = 0 To 11
QtyArray(rw, col) = Cells(rw + 2, col + 3).Value
MsgBox QtyArray(rw, col)
Next col
Next rw
End Sub
I want to apply logic as per below:
First identify columns where COUNTA is 1 (highlighted in red) and move 1 qty of stock from that store to another store where COUNTA > 2, priority would be in order from store A to L. For example, first store with COUNTA=1 is store D, and it has qty 2. So I want to move these 2 qty to store E (not store C because it has already 1 qty, also H has 2 qty.)
If the COUNTA of any store's qty is zero, nothing to be done.
I want to fetch separate report as per below format, showing how the stock is being moved across store as per logic rule 1.
Output:
Explained in previous section.
Related
I need some help with a database I am trying to create on excel. Currently, I managed to build a system where I paste on to the excel sheet a receipt, then a macro extract certain pieces of information and stores it in another sheet, something like this;
BUYER SELLER DATE PRODUCTS CURRENCY
A B 123 abc USD
D E 456 def GBP
Now, I can search this database using simple filtering. What I would to do now is, once I have filtered and am left with, lets say, 5 entries, I would like those to be reconstructed in another sheet, looking like the receipts do originally e.g
123 456
A D
B E
USD GBP
a d
b e
c f
I know I need to loop through each row and once in a row, loop through each column to extract the required piece of information(e.g date, products etc).
I have looked around and couldn't find anything.
Any help would be appreciated, thank you.
I think that this can help you to start:
Sub From_DB()
Dim i As Long
Dim col As Integer
Dim DB_Sheet, Rec_Sheet As Object
Set DB_Sheet = ThisWorkbook.Worksheets("Database")
Set Rec_Sheet = ThisWorkbook.Worksheets("Receipts")
col = 1
For i = 2 To DB_Sheet.Range("A" & Rows.Count).End(xlUp).Row
If DB_Sheet.Rows(i).Hidden = False Then
Rec_Sheet.Cells(1, col) = DB_Sheet.Cells(i, 3)
Rec_Sheet.Cells(2, col) = DB_Sheet.Cells(i, 1)
Rec_Sheet.Cells(3, col) = DB_Sheet.Cells(i, 2)
Rec_Sheet.Cells(4, col) = DB_Sheet.Cells(i, 5)
Rec_Sheet.Cells(5, col) = DB_Sheet.Cells(i, 4)
col = col + 1
End If
Next i
End Sub
I need to summarize unique values from a row into a column that's in the same row. My goal is in the second row of the attached image where T:Z contains the data and AA:AC contains the summary (I typed the values in for the demo). The first row is what is currently occurring where I tried using a nested if function for values greater than zero, but I also tried using an index match function to no avail. The issue is I either receive duplicates in AA:AC or not all values are included.
Currently using Excel 2016
So if I understand you correctly, you are going to have a sheet of rows of data. You want to look in the columns T:Z and then generate a list of unique values (non-zero) in the columns AA:AC. I assume that you know you will never have more than 3 unique values, but I can't be sure that this wasn't just an omission.
Either way, the below code should work:
Sub Find_Uniques()
Dim X As Integer, Y As Integer, Z As Integer
Dim Temp_Strings() As String
For X = 1 to 10000 'This assumes you don't have more than 10,000 rows of data
ReDim Temp_Strings(1 to 5) As String
For Y = 20 to 26
If Range(Cells(X,Y).Address).Value <> "" And Range(Cells(X,Y).Address).Value <> 0 Then
For Z = 1 to 5
If Temp_Strings(Z) = "" Then
Temp_Strings(Z) = Range(Cells(X,Y).Address).Value
Exit For
End If
If Temp_Strings(Z) = Range(Cells(X,Y).Address).Value Then Exit For
Next Z
End If
Next Y
For Z = 1 to 5
If Temp_Strings(Z) <> "" Then Range(Cells(X,Z+26).Address)).Value = Temp_String(Z)
Next Z
Next X
End Sub
Thank you all for your help. Instead of extracting the data from the row, I wrote a macro that changed the zeros to blanks, deleted the blank cells, and shifted them to the left. After that it was easy to cut the range and paste it into the old data set to be analyzed.
Sub clean_data()
Sheets("Reason data").Range("H:Z").Replace 0, ""
Call delete_blanks
End Sub
Sub delete_blanks()
Sheets("Reason data").Range("H:Z").SpecialCells(xlCellTypeBlanks).Delete (xlToLeft)
Call move_data
End Sub
Sub move_data()
'Copies reason data and pastes it into data worksheet
Sheets("Reason data").Range("A3:K3", Sheets("Reason data").Range("A3:F3").End(xlDown)).Cut _
Sheets("Data").Range("A1").End(xlDown).Offset(1)
End Sub
I have an excel document with two sheets. Sheet 1 has columns A-Q and Sheet 2 has columns A-H. What I need is a code that will copy the information in a row from sheet 1 to sheet 2 if the criteria is met. The criteria is the word "Awarded" in column L (Sheet 1).
Also is it possible to have only specific columns in the row copied?
A B C D E F G H I J K L M N
X X Awarded X X
I would like to have only columns C,D,M, and N copied from the row if the word "awarded" is in column L. This information would be copied to Sheet 2 in the following fashion
Sheet 1 Sheet 2
D --> B
C --> C
M --> D
N --> F
I hope I'm being clear. Thanks in advance and let me know if I need to clarify!+
This is the code I currently have, which works. Only problem is it copies the entire row of information into sheet 2 when I only want rows D,C,M, and N to be copied.
Sub testing()
Set a = Sheets("Sheet1")
Set b = Sheets("Sheet2")
Dim d
Dim j
d = 1
j = 2
Do Until IsEmpty(a.Range("L" & j))
If a.Range("L" & j) = "Awarded" Then
d = d + 1
b.Rows(d).Value = a.Rows(j).Value
End If
j = j + 1
Loop
End Sub
First what you should do is change your data structure. Assuming you are using Excel 2007 or later, there is a great feature called Tables. If you highlight all of your data and go to Insert->Table, select the "My Table Has Headers" checkbox, and press ok, you will see a nicely formatted table. Do that for both of the data sets on each sheet.
This is more than just pretty formatting though, it is what is called a ListObject. In your VBA code, use the following to reference it:
Dim Table1 as ListObject, Table 2 as ListObject
Dim HeaderIndex as Integer
Dim MyColumnRange as Range
Set Table1 = Sheet1.ListObjects("TableName1")
`Change the table name under Formulas->Name Manager
Set Table2 = Sheet1.ListObjects("TableName2")
HeaderIndex = Application.WorksheetFunction.Match("ColumnLHeaderName", _
Table1.HeaderRowRange, 0)
Set MyColumnRange = Table1.ListColumns(HeaderIndex).DataBodyRange
MyColumnRange.Select
At this point, the select statement is just to show you what range you are dealing with now. The HeaderIndex refers to the header sub component of the table ListObject. Using Match() will allow you to specify the name of the column header without hard coding it's position. (i.e. if your data starts in column A, the header value in column L will return HeaderIndex = 12)
Now that you know what column you want, you select the ListColumn object. Then, the DataBodyRange is used to select the range component of that object. This is the entire range in that column. You can then iterate down the list to find the data you want.
EDIT: Updated Example:
'Specify your ranges you will be copying from beforehand, adding as many as you need here.
HeaderIndex_D = Application.WorksheetFunction.Match("ColumnXHeaderName", _
Table1.HeaderRowRange, 0)
HeaderIndex_C = Application.WorksheetFunction.Match("ColumnXHeaderName", _
Table1.HeaderRowRange, 0)
HeaderIndex_M = Application.WorksheetFunction.Match("ColumnXHeaderName", _
Table1.HeaderRowRange, 0)
HeaderIndex_N = Application.WorksheetFunction.Match("ColumnXHeaderName", _
Table1.HeaderRowRange, 0)
Set ColumnRange_D= Table1.ListColumns(HeaderIndex_D).DataBodyRange
Set ColumnRange_C= Table1.ListColumns(HeaderIndex_C).DataBodyRange
Set ColumnRange_M= Table1.ListColumns(HeaderIndex_M).DataBodyRange
Set ColumnRange_N= Table1.ListColumns(HeaderIndex_N).DataBodyRange
'Now, loop through each row that exists in your table. If the testing
'condition contained in MyColumnRange you previously defined is met,
'then assign the destination cell (which can be defined in the same way
'as above) equal to the lookup range's current row value (specified by i)
For i = 1 to MyColumnRange.Rows.Count
If MyColumnRange(i) = "Awarded" Then
DestinationCell1.Value = ColumnRange_D(i)
DestinationCell2.Value = ColumnRange_C(i)
DestinationCell3.Value = ColumnRange_M(i)
DestinationCell4.Value = ColumnRange_N(i)
End If
Next i
My model takes two numbers from one sheet, adds the average to another sheet in the last cell of a defined column. The problem that I have is that when I insert a new column, the references get missed up and I'm trying to have a macro that would 1. take the average 2. look for a specific column on the second sheet 3. paste the averaged value to the last cell.
Please help me with this I have been trying to get my head around it for a long time.
my problem is that I have to insert new columns and I need to keep the references dynamic when adding a value to the last empty cell in a column. For example: if i have salary as col A, and expenses as Col B - in this model that I have now I put in .Cells(emptyRow, 1) and .Cells(emptyRow, 2) now if I insert a column between A and B the references 1 and 2 will not work. Is there anyway that I can work around this where if i add a new column it wont mess up the references in the macro?
Thank you.
This is the code that I have right now but it does not really work - when I insert a new column the column defined name does not shift right.
Sub demo()
Dim expCol As Long, FirstEmptyRow As Long
Range("B:B").Cells.Name = "expenses"
expCol = Range("expenses").Column
FirstEmptyRow = Cells(Rows.Count, expCol).End(xlUp).Row + 1
Cells(FirstEmptyRow, expCol).Value = 123
End Sub
P.S. 123 here is just an example for testing purposes. The value that would replace it in my model is the average I talk about in the question.
If your columns have headers (I guess they do), and your data has no gaps just use
Range("1:1").Find(columnName).End(xlDown).Offset(1,0) = 123
If a column can have just a header but no values, you need to add additional check if second row isn't empty.
If you create a named range this way (rather than the Range.Cells.Name way you were using), then when inserting columns the reference will be dynamic. Now if you insert columns between A and B later in the code, you can still use expCol and FirstEmptyRow to reference the first empty cell in the expenses column, where ever it may have moved to on the sheet, as long as you update them after each column insertion.
Sub Demo()
Dim expensesrng As Range
Dim Expenses As Range
Dim expCol As Long
Dim Exprng As Range
Dim FirstEmptyRow As Long
'set the original range to use for the expense column
Set expensesrng = Range(Range("B1"), Range("B1").End(xlDown))
'add the named range
ActiveWorkbook.Names.Add Name:="Expenses", RefersTo:=expensesrng
' create a variable to refer to the Expenses Range
Set Exprng = ActiveWorkbook.Names("Expenses").RefersToRange
expCol = ActiveWorkbook.Names("Expenses").RefersToRange.Column
FirstEmptyRow = Exprng.End(xlDown).Offset(1, 0).Row
Cells(FirstEmptyRow, expCol).Value = 123
'after inserting columns then you will have to get/update the column number
'of the expense named range and the first empty row before adding your new expense
'data to it
Range("B:B").Insert Shift:=xlShiftToRight
expCol = ActiveWorkbook.Names("Expenses").RefersToRange.Column
FirstEmptyRow = expensesrng.End(xlDown).Offset(1, 0).Row
Cells(FirstEmptyRow, expCol).Value = 123
End Sub
I am trying to program a noise reduction algorithm that works with a set of datapoints in a VB.NET DataTable after being helped with my other question. Basically, I want to take two integers, a coordinate value (yCoord for example) and a threshold smoothing value (NoiseThresh), and take the average of the values in the range of (yCoord - NoiseThresh, yCoord + NoiseThresh) and store that number into an array. I'd repeat that process for each column (in this example) and end up with a one-dimensional array of average values. My questions are:
1) Did anything I just say make any sense ;), and
2) Can anyone help me with the code? I've got very little experience working with databases.
Thanks!
An example of what I'm trying to do:
//My data (pretend it's a database)
1 4 4 9 2 //yCoord would equal 5
6 3 8 12 3 //yCoord = 4
8 3 -2 2 0 //yCoord = 3
9 17 3 7 5 //yCoord = 2
4 1 0 9 7 //yCoord = 1
//In this example, my yCoord will equal 3 and NoiseThresh = 1
//For the first column
Array(column1) = //average of the set of numbers centered at yCoord = 3 _
//(in this case 8) and the NoiseThresh=1 number on either side (here 6 & 9)
//For the second column
Array(column2) = //average of the numbers 3,3,17 for example
//etc., etc.,
This would be performed on a large data set (typical numbers would be yCoord=500, NoiseThresh = 50, Array length = 1092) so there is no possibility of manually entering the numbers.
I hope this helps clarify my question!
P.S.: yes, I know that // isn't a VB.NET comment.
I must admit that i've yet not understood the range part (NoiseThresh etc.), but this is a start:
Dim averages = (From col In tbl.Columns.Cast(Of DataColumn)()
Select tbl.AsEnumerable().
Average(Function(r) r.Field(Of Int32)(col.ColumnName))).
ToArray()
It calculates every average of each column in the DataTable and creates a Double() from the result (average can result in decimal places even if used on integers).
Edit: With your example i've now understood the range part. So basically yCord is the row-index(+1) and noiseThreas is the row-range (+/- n rows).
Then this gives you the correct result(made some code comments):
Dim yCord = 2 ' the row index(-1 since indices are 0-based) '
Dim noiseThresh = 1 ' +/- row '
' reverse all rows since your sample begins with index=5 and ends with index=1 '
Dim AVGs As Double() = (
From colIndex In Enumerable.Range(0, tbl.Columns.Count)
Select tbl.AsEnumerable().Reverse().
Where(Function(r, index) index >= yCord - noiseThresh _
AndAlso index <= yCord + noiseThresh).
Average(Function(r) r.Field(Of Int32)(colIndex))).ToArray()
The most important part of this this LINQ query is the Where. It applies your range on the IEnumerable(of DataRow). Then i'm calculating the average of these rows for every column. The last step is materializing the query to a Double().
Result:
(0) 7.666666666666667 Double => (6+8+9)/3
(1) 7.666666666666667 Double => (3+3+17)/3
(2) 3.0 Double => (8-2+3)/3
(3) 7.0 Double => (12+2+7)/3
(4) 2.6666666666666665 Double => (3+0+5)/3
Edit2:
One last thing. I assume that to do the same for the other axis I just
switch x & y and row & column?
It's not that simple. But have a look yourself:
Dim noiseThresh = 1 ' +/- column '
Dim xCord = 2 ' the column index(-1 since indices are 0-based) '
' assuming that your x-cords now start with index=0 and ends with tbl.Column.Count-1 '
Dim AVGs As Double() = (
From rowIndex In Enumerable.Range(0, tbl.Rows.Count)
Select tbl.Columns.Cast(Of DataColumn)().
Where(Function(c, colIndex) colIndex >= xCord - noiseThresh _
AndAlso colIndex <= xCord + noiseThresh).
Average(Function(c) tbl.Rows(rowIndex).Field(Of Int32)(c.Ordinal))).ToArray()
Result:
(0) 5.666666666666667 Double => (4+4+9)/3
(1) 7.666666666666667 Double => (3+8+12)/3
(2) 1.0 Double => (3-2+2)/3
(3) 9.0 Double => (17+3+7)/3
(4) 3.3333333333333335 Double => (1+0+9)/3