i have made this table in excel of items of food from a menu with their nutritional value. I've then got another table that has each item in one row and the quantity consumed of each item In the row below. I've then used the solver tool in excel to optimise the meal choices with set constraints on the amount of calories a meal can be as well as certain restrictions on the nutritional values that I have used.
When I run the simplex algorithm through the solver tool what happens is the values in the table for quantity consumed changes to reflect what you should eat given the constraints.
I want to make it flexible so that I can change the constraints and get different results but what I want is an easy way to show the choices made. Currently what I have is an index match on another tab to table and the values which I then apply a filter to and take off all the items with '0' for quantity consumed however this has to be done each time I run the solver.
Is there any way to pull the non zeros and display what item these refer to without having to redo the filter every time ?
Here's a simple routine I use to look up something in a spreadsheet table and post the results on the same page (easily changed to post on another sheet). Hope this helps or heads you in the right direction. (Crude but effective)
Private Sub CommandButton3_Click()
'FIND A VALUE IN THE LIST AND POST RESULTS
Dim myName, myNumber, myComp
'Clear the results area
With Worksheets("SheetName").Range("H2:J30").ClearContents
End With
x = 2 'The row to start posting results to
y = 0
'This is the range to search
With Worksheets("SheetName").Range("A1:D300")
Set found = .Find(What:=y, LookIn:=xlValues, LookAt:=xlWhole)
If Not found Is Nothing Then
firstAddress = found.Address
Do
Set ws = Sheets("SheetName")
myName = ws.Range("A" & found.Row).Value 'Value in column A
myNumber = ws.Range("B" & found.Row).Value 'Value in column B
myComp = ws.Range("C" & found.Row).Value 'Value in column C
'I use a MsgBox at first for testing, then comment it out when I know it's working
'MsgBox myName & " " & myNumber & " " & myComp
'Post the results to the desired area
ws.Range("H" & x).Value = myName
ws.Range("I" & x).Value = myNumber
ws.Range("J" & x).Value = myComp
x = x + 1
Set found = .FindNext(found)
If found Is Nothing Then
GoTo DoneFinding
End If
Loop While Not found Is Nothing And found.Address <> firstAddress
End If
DoneFinding:
End With
Range("A2").Select
End Sub
Related
My situation is as follows. I have a list of around 2k student accounts and sort the information to a specific format that i can format to our new CRM. The way the data is presented initially makes that problematic.
As you can see on the first screenshot, every student's university choice is presented in a separate row. So if a student has chosen more than one university, data about it is stored in 2-6 rows (each student can select 1 to 6 universities) repeating his personalID, name, forename and DoB every line.
What I need to achieve is to remove repeating information and store all data about each student in one row per student(example on screenshot 2).
I have no idea how to achieve this using VBA. I was trying with IFs, loops and arrays but without any progress. I need help on how to accomplish that using VBA.
Please let me know if you need more information. I will try to explain it in more details if required.
Screenshot 1
Screenshot 2
EDIT: This is the part of the report. I am working on a macro that will format it to our needs and will give us more info about the student's accounts. That is why I am asking for help in VBA.
No need to use VBA for this. Power Query will help you better. Have a look here: https://excelgorilla.com/power-bi/power-query/aggregate-text-values-using-group-by/
This seems to work. I'm new to VBA and programming in general so it's possibly not the most efficient solution and can definitely be improved.
Instead of working with a blank sheet, it transforms the current data to the format you wanted. You can add field headings where you want.
Edit: It assumes that each Student has 5 universities in the list. The code can be adjusted to account for any number by just adjusting the target range dynamically.
Edit 2: I added the change to account for students who've entered any number of universities between 1 to 5. Let me know if this gets it done!
Sub ReArrange_Data()
Dim lrow As Long
lrow = Cells(Rows.Count, 1).End(xlUp).Row
Dim First As Integer
Dim Last As Integer
Dim test As Integer
Dim test1 As Integer
Dim student_range As Range
Dim student_rows As Integer
Dim target_range As Range
First = 2
For i = 2 To lrow
Last = First
If Cells(First, "D").Value = "" Then GoTo Break 'reached end of data
While Cells(Last, "D").Value = Cells(Last + 1, "D").Value
Last = Last + 1
Wend
If Last <> First Then 'check if mulitiple uni and build range
Set student_range = Range("E" & First & ":" & "E" & Last)
student_rows = student_range.Rows.Count
If student_rows = 5 Then
Set target_range = Range("E" & First & ":" & "I" & First)
ElseIf student_rows = 4 Then
Set target_range = Range("E" & First & ":" & "H" & First)
ElseIf student_rows = 3 Then
Set target_range = Range("E" & First & ":" & "G" & First)
ElseIf student_rows = 2 Then
Set target_range = Range("E" & First & ":" & "F" & First)
End If
Else
GoTo Skip 'student entered one uni, go to next loop
End If
target_range = Application.WorksheetFunction.Transpose(student_range.Value) 'row to column
Rows(First + 1 & ":" & Last).EntireRow.Delete
Skip: 'delete repeated entries
First = First + 1
Next i
Break:
End Sub
I have written a code in VBA where a V-Lookup is done if a certain condition is met.
It works fine but now how can I do the same thing to the next row data values without the need to rewrite the code.
Sub starting_stock()
If Worksheets("out").Range("E2").Value = "" Then
Set ItemRef = Worksheets("out").Range("A2")
Set MyRange = Worksheets("Inventory").Range("A:G")
Worksheets("out").Range("D2").Value = Application.WorksheetFunction.VLookup(ItemRef, MyRange, 7, False)
End If
End Sub
I want to do the same to D3 with values of E3, A3 without the need to rewrite the code every time.
This is an Stock Control System.
There are two sheets, One is called "Inventory" and the other is called "out".
Field in Inventory : ProductRef,Initial Stock, Stock Out(SUMIF for all Qty Out corresponding to a particular ProductRef), Final Stock.
Field in out : Product Ref, Starting Stock, Qty out, Remaining Stock, Date.
The aim here is to V-lookup the Final Stock from Inventory into Starting Stock if Qty Out is Null and as per the V-Lookup criteria of product Ref.
Remaining Out has a simple formula Starting Stock- Qty Out.
A normal formula cannot be used since any changes made in Qty will affect all previous entries with the same Product Ref.
Starting Stock should be as at date and remain as such.
All you need to do is wrap it in a For loop. See below:
Option Explicit
Sub starting_stock()
Dim i As Long
For i = 2 To 3
If Worksheets("out").Range("E" & i).Value = "" Then
Set ItemRef = Worksheets("out").Range("A" & i)
Set MyRange = Worksheets("Inventory").Range("A:G")
Worksheets("out").Range("D" & i).Value = Application.WorksheetFunction.VLookup(ItemRef, MyRange, 7, False)
End If
Next i
End Sub
Read more about For loops here: https://excelmacromastery.com/vba-for-loop/
I assume this is what you are looking for:
You want to select a cell in a column and run the code and it will use value of the A column on the same row to perform the vlookup and paste the value in D column with the same row?
In that case ActiveCell.row is probably what you need.
Sub starting_stock()
If Worksheets("out").Range("E" & ActiveCell.Row).Value = "" Then
Set ItemRef = Worksheets("out").Range("A" & ActiveCell.Row)
Set MyRange = Worksheets("Inventory").Range("A:G")
Worksheets("out").Range("D" & ActiveCell.Row).Value = Application.WorksheetFunction.VLookup(ItemRef, MyRange, 7, False)
End If
End Sub
I have found the following solution:
Sub Button_Click()
Dim i As Integer
i = 2
Do While Worksheets("out").Cells(i, 1).Value <> ""
If Worksheets("out").Range("E" & i).Value = "" Then
Set ItemRef = Worksheets("out").Range("A" & i)
Set MyRange = Worksheets("Current Inventory").Range("F:M")
Worksheets("out").Range("D" & i).Value = Application.WorksheetFunction.VLookup(ItemRef, MyRange, 8, False)
End If
i = i + 1
Loop
End Sub
A while loop with the condition of not empty ProductRef.
I have 32.000 rows with data. Some data are in a different place and I want to join them with something that I can apply to all rows and not manually. Each "group" have the same ID, in this example is "XPTO"
I have something like this now (but with more columns):
I want it to be like this:
The problem is that I need a clever way, because they are not always exactly like this example. Some of them have 10 rows with the same ID "XPTO" (example)
I am struggling with this =/ ty
Here's how I would approach this.
1) From your comment, I understand that the logic is positional (the first one on the left (Casteloes de) goes with the first one on the right (R Dr Antonio) for the matching value in column A. If that is true, then I would insert a column where you start numbering sequentially, then Fill Down to get sequential numbers all the way to the end. This will help preserve the positional logic if you need to sort or rearrange your data. It will also help you with the logic of "first match", "second match", etc.
2) My next step would be to separate the two sets of data into separate tables/tabs (with the sequentially numbered column appearing in each) and use INDEX/MATCH. The recent answer here will help you with how to increment the match: Is there such thing as a VLOOKUP that recognises repeated numbers?
3) Alternative - this may even be easier, although you'll want to do extensive data checking to make sure nothing got screwed up. With the two tables from step 2, sort by any column with data in it, then delete the blank rows from each table. Then, sort each by the sequentially numbered column to return to the original order. At that point you may be able to just copy and paste. Check carefully for errors if you do this.
I am positive that the solution above given by CriketBird work, at least it has a good logic to solve it, but since I am a newbie in excel, I couldn't figure it out how to solve it that way.
So I solved it by using VBA in excel...(maybe I went too far for this simple problem, but it was my only option).
I will leave the code here if someone want it for a similar situation. (just select the first column and row your table starts and hit run)
Function Area(medico As String) As Integer
Do While countOk < 1
If medico = ActiveCell.Value Then
ActiveCell.Offset(1, 0).Select
rowCount = rowCount + 1
Else: countOk = 1
End If
Loop
Area = rowCount
End Function
Sub Teste()
Dim PaginaMedico As String
Dim totalrowCount As Integer
Dim rowCount As Integer
Dim countOk As Integer
Dim right As Integer
Dim left As Integer
Dim listaleft As New Collection
Dim listaright As New Collection
rowCount = 1
rowOk = 0
totalrowCount = 0
right = 0
left = 0
Do While ActiveCell.Value <> 0
PaginaMedico = ActiveCell.Value
rowCount = Area(PaginaMedico)
totalrowCount = totalrowCount + rowCount
Range("A" & (totalrowCount - (rowCount - 1))).Select
For i = ((totalrowCount + 1) - rowCount) To totalrowCount
If IsEmpty(Range("E" & (i)).Value) And IsEmpty(Range("F" & (i)).Value) Then
Range("T" & (i)).Value = "Empty"
ElseIf Not IsEmpty(Range("E" & (i)).Value) And Not IsEmpty(Range("F" & (i)).Value) Then
Range("T" & (i)).Value = "Full"
ElseIf Not IsEmpty(Range("E" & (i)).Value) And IsEmpty(Range("F" & (i)).Value) Then
left = left + 1
listaleft.Add i
ElseIf IsEmpty(Range("E" & (i)).Value) And Not IsEmpty(Range("F" & (i)).Value) Then
right = right + 1
listaright.Add i
End If
Next i
If Not (right = left) Then
Range("T" & totalrowCount).Value = "BOSTA"
right = 0
left = 0
End If
If listaleft.Count = listaright.Count Then
For i = 1 To listaleft.Count
Range("F" & listaright(1) & ":" & "S" & listaright(1)).Cut Range("F" & listaleft(1) & ":" & "S" & listaleft(1))
listaright.Remove (1)
listaleft.Remove (1)
Next i
End If
Set listaleft = New Collection
Set listaright = New Collection
Range("A" & (totalrowCount + 1)).Select
Loop
End Sub
I want to use the .find function in VBA to find instances of a value in a column, however there are calculations which are made based on criteria on the same rows as where the value is found. This is problematic because although the value I am looking for might be the same, the criteria which are used to create the overall score are different. As a result, I would need to loop through all the values which are found in the column and I was wondering how to do that in vba. I know the findnext function but I can never get it to work properly.
counted = Application.WorksheetFunction.CountIfs(cl.Range(finletter & "9:" & finletter & "317"), "Value", cl.Range("H9:H317"), wl.Range("A" & y.row).Value)
'Pol small low complex
If counted > 0 Then
MsgBox wl.Range("A" & y.row).Value
If cl.Range("C" & y.row).Value < 3 And cl.Range("D" & y.row).Value = 1 And cl.Range("E" & y.row).Value = "Interim" Then
wl.Range(y.Address) = 3.75 * counted
Here is an example. Say we are looking for the text "LOVE" in column A and process the data on those rows:
Option Base 1
Sub LookingForLove()
Dim s As String, rng As Range, WhichRows() As Long
Dim rFound As Range
ReDim WhichRows(1)
s = "LOVE"
Set rng = Range("A1:A25")
Set rFound = rng.Find(What:=s, After:=rng(1))
WhichRows(1) = rFound.Row
Do
Set rFound = rng.FindNext(After:=rFound)
If rFound.Row = WhichRows(1) Then Exit Do
ReDim Preserve WhichRows(UBound(WhichRows) + 1)
WhichRows(UBound(WhichRows)) = rFound.Row
Loop
msg = UBound(WhichRows) & vbCrLf & vbCrLf
For i = 1 To UBound(WhichRows)
msg = msg & WhichRows(i) & vbCrLf
Next i
MsgBox msg
End Sub
NOTE:
the Exit Do prevents looping forever
your code would continue by looping the elements of WhichRows() and processing the items on those rows.
your code could alternatively create a dynamic array of ranges or cell addresses.
Another alternative approach would be to use VBA to establish an AutoFilter and process the visible rows.
I haven't found an appropriate answer for this question and I'm very new to VBA, so I hope someone will help me out.
I'm trying to create a Sub in my macro that does a simple value compare between two columns, row by row. If they are an exact match it will populate a third column with "Yes", otherwise it will say "No"
All columns are within an excel Table and have the same amount of rows, an example of what the result should look like is this (don't have enough rep to post image):
I was thinking something like a For Each statement but I'm not sure how to create it the right way. Thank you ahead of time for your help!
Quick subroutine to loop through rows 1 through 20 and compare results:
for i = 1 to 20
If sheet1.range("A" & i).value = sheet1.Range("B" & i).value Then
sheet1.Range("C" & i).value = "No"
Else
sheet1.Range("C" & i).value = "Yes"
End if
Next i
Because this seems like more of a learning experiment, you can also reference cells by:
for i = 1 to 20
If sheet1.cells(i,1).value = sheet1.cells(i,2).value Then
sheet1.cells(i,3).value = "No"
Else
sheet1.cells(i,3).value = "Yes"
End if
Next i
You mention the range will vary in size. You can get the last row that is populated and then loop from 1 to that with:
Dim endRow as long
endRow = Sheet1.Range("A999999").End(xlUp).Row
for i = 1 to endRow
If sheet1.range("A" & i).value = sheet1.Range("B" & i).value Then
sheet1.Range("C" & i).value = "No"
Else
sheet1.Range("C" & i).value = "Yes"
End if
Next i
A table will automatically bring formulas to a new row when a new row is inserted. For instance, say you have the following table where the Same? column contains the formula =IF(C3=D3, "Yes", "No")
As you enter a new row in the table, the formula in the Same? column will be automatically brought to the new row. For example, this is what that cell will look like once I hit Tab to create a new row:
Now say you want to completely repopulate the table with a new set of data. That's no problem, simply copy the new data and paste it in the table like so:
Copy
Paste into first cell
The table takes care of the formulas for you, effectively making a macro unnecessary.
Thank you all for your input!
I took elements from your answers and managed to come up with a code that solves my problem. Let me know if you have any questions
Sub Compare
On Error Resume Next
Dim Sm_Row As Long
Sm_Row = Range("Table1[Same?]").Row
For Each cl In Range("Table1[Same?]")
If Range("Table1[Col1]").Cells(Sm_Row, 1).Value = Range("Table1[Col2]").Cells(Sm_Row, 1).Value Then
cl.Value = "Yes"
Else
cl.Value = "No"
End If
Sm_Row = Sm_Row + 1
Next cl
End Sub