Excel-insert cell value at another cell each time - excel

I have some specific (different) numbers which will be the lead-time of the order to arrive to e.g. a warehouse, meaning that the lead-time is stochastic. I want the "ordered quantity" to be inserted "x" rows down at the "order arrival" column. For example, as seen in the photo, I want the "100" ordered quality to be inserted two rows down at "order arrival", and afterwards "120" to be inserted 5 rows down at "order arrival".
Is there a way to do that with a function in excel?Any ideas? Thanks 1
example

Hopefully the screenshot and code sample below will help you get started. I cannot think of a way to do what you want without using macros though I am sure there are some experts on here who may be able to come up with an amazing formula!
Please see the screenshot attached below. I have reformatted your table slightly for the purposes of demonstration, so now it looks like this:
I then wrote the following macro. Its a very rough-and-ready macro as Im at work and about to go home, but it should get you started:
Sub runorders()
Worksheets("Sheet1").Range("D2:D1000").ClearContents
readrow = 2
currentday = Worksheets("Sheet1").Range("A" & readrow).Value
currentleadtime = Worksheets("Sheet1").Range("B" & readrow).Value
currentorderquantity = Worksheets("Sheet1").Range("C" & readrow).Value
Do Until currentday = ""
If currentorderquantity <> "" Then
Worksheets("Sheet1").Range("D" & readrow + currentleadtime).Value = Worksheets("Sheet1").Range("D" & readrow + currentleadtime).Value + currentorderquantity
End If
readrow = readrow + 1
currentday = Worksheets("Sheet1").Range("A" & readrow).Value
currentleadtime = Worksheets("Sheet1").Range("B" & readrow).Value
currentorderquantity = Worksheets("Sheet1").Range("C" & readrow).Value
Loop
End Sub
Obviously for the code to work you will need the workbook set up exactly as I have done so in the screenshot. The cells highlighted in orange will need your normaldistribution formula. Don't forget that each time the macro writes the "order arrival" value into a cell in column d, the random distribution values will change (e.g. re-sample) unless you do something about it.
I hope this helps!
Paul

Related

Compute countif in column Range & combine if with count if

I have two formulas that I need to transfer to VBA.
On Excel, my formula would be =countif(A$2:A2,A2) so I transferred that using this formula but everything is returning to 1. The rows didn't become dynamic and I want only the values to be displayed.
For a = 2 To lrow
ws.Range("T" & a).Formula = "=CountIf(A$2&"":""&A2)"",""&A2)"
Next a
Next formula that I use in Excel is
=IF(COUNTIF(A:A,A2)>Q2,"Check","Ok")
I tried this formula in VBA:
For i = 2 to lrow
If Countif(ws.Range("A2:A" & lrow), "A2") > ws.Range("Q2:Q", & lrow) Then
ws.Range("T" & i).Value = "Check"
Else
ws.Range("T" & i).Value = "Ok"
End If
Next i
You could populate column T with your first formula with this line of code:
ws.Range("T2:T" & lrow).FormulaR1C1 = "=COUNTIF(R2C[-19]:RC[-19],RC[-19])"
I can't advise on your second formula unless you clarify where you want to write it...

Calculate time difference between 2 dates and give outputs in total hours is generating output as #### which is wrong

I am very new to Excel, VBA, Macro. My macro was working fine because I gave a simple formula, for example, D2(column name)-C2(column name) = Total time in HH:MM format new column. But I notice for some output is just #### not sure what is wrong. 1).Column)).Formula = _
"=" & cl.Offset(1, 0).Address(0, 0) & "-" & .Cells(2, col1).Address(0, 0)
cl.Offset(, 1).EntireColumn.NumberFormat = "[hh]:mm"
The issue occurs because your date in J is earier than in I and therefore the result is negative. You can use the ABS() function to get the absolute difference as positive value.
Therefore adjust your formula as below:
.Formula = "=ABS(" & cl.Offset(1, 0).Address(0, 0) & "-" & .Cells(2, col1).Address(0, 0) & ")"
You have an incorrect formula in this line:
.Range(cl.Offset(1, 1), .Cells(lastR, cl.Offset(1, 1).Column)).Formula = _
"=" & cl.Offset(1, 0).Address(0, 0) & "-" & .Cells(**2**, col1).Address(0, 0)
Why .Cells(2, col1)? This is always giving you row2 of column 1.
Also, after this line:
If cl.Value = "Full Out Gate at Inland or Interim Point (Destination)_recvd"
Then
Add:
If cl.Offset(0,1).Value = "Response Time" Then Exit For
This will keep you from inserting a new column every time you run the macro.
Try using clear variable names and consistent method for referring to rows and columns.
actCol = col1
recvdCol = cl.Column
responseCol = cl.offset(0,1).Column
.Range(lastR, responseCol).Formula = _
"= Abs(" & .Cells(lastR, recvdCol) & "-" & .Cells(lastR, actCol).Address(0, 0) & ")"
I would use a simpler approach. Highlight the entire table, and click "Format as Table", and be sure to check off "My table has headers." This will give you a named range (default name is Table1, but you can change it). Then, in the Response Time column, simply enter your formula on the first row of the table, but use your mouse to select the cells instead of typing in a cell name like "I2". You will find that the resulting formula includes something like =[#actl]-[#recvd], except that the actl and recvd will be replaced by your actual column names. And, the formula will apply to every row of the table. If you add a new row, the formula will automatically appear in that row. No code needed.
If you have a reason to use code instead of a Table (named ranges), then I would recommend (1) this code be placed directly in the "Main" worksheet module and (2) use use the "Worksheet_Changed" procedure. Microsoft Excel VBA Reference. In this case, any time the
Private Sub Worksheet_Change(ByVal Target As Range)
'Note, Target is the Range of the cell(s) that just changed.
If Intersect(Target, Range("A1:A10")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
If ActiveSheet.Cells(1, Target.Column) = "Full Out Gate at Inland or Interim Point (Destination)_actual" Then
' Cell in actual column was modified. Let's set the formula in the Response Time column:
On Error Goto EH
Application.EnableEvents = False
' Add your code here. You'll need to modify it somewhat to accommodate this methodology.
Application.EnableEvents = True
End If
EH:
Application.EnableEvents = True
Err.Raise ' expand this to whatever error you wish to raise
End Sub
Err.Raise help

How To Consolidate Multiple Rows Into One Row

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

Pulling non zero values from excel

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

Creating a macro in Excel that compares two columns, answers in third column

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

Resources