Need help with VBA code to remove approximate matching numbers from two columns that is Amt1 and Amt 2:
Amt 1 Amt 2
412.82 0
671.44 0
54.25 412.83
574.89 671.44
0 484.2
0 370.53
0 54.25
0 574.9
0 594.43
Desired Result: I want 412.82 from column Amt 1 and 412.83 from column Amt 2 should be removed from both the columns.
Sub removedup()
Dim source As Range
Dim iCol1 As Long
Dim iCol2 As Long
Dim nRow1 As Long
Dim nRow2 As Long
Dim nCol As Long
Dim nRow As Long
Set source = Selection
nCol = source.Columns.Count
nRow = source.Rows.Count
iCol1 = 1
iCol2 = 2
For iRow1 = 1 To nRow
For iRow2 = 1 To nRow
If (Cells(iRow1, iCol1) - Cells(iRow2, iCol2) >= -3) And (Cells(iRow1, iCol1) - Cells(iRow2, iCol2)) <= 3 Then
Cells(iRow1, iCol1) = ""
Cells(iRow2, iCol2) = ""
End If
Next iRow2
Next iRow1
End Sub
Actually this task would be much more complicated as you think
To find similar values you would need to work with the distances between these values and if the distance is smaller than a defined threshold then they are considered as being "similar".
But it gets really hard if there are more similar distance.
My thoughts, imagine the following data:
If you define that a distance <= 0.02 is considered as similar then the following pairs are considered as similar:
Scenario 1
You start comparing from the top and you find that 412,84 and 412,83 are similar and delete them immediately. Then you will remain with 412,81 and 412,85 which are not similar (distance is 0.04) and they will be kept.
Scenario 2
You compare first 412,84 and 412,85 and delete them as similar then you will remain with 412,81 and 412,83 and they will also be deleted as similar. No values will be kept at all.
What does that mean?
There is not only one solution for this szenario and you will get different results on the same data-set (with differently ordered values). So you have to calculate all of the scenarios and decide which one is the correct one, because your algorithm can't decide that.
What to do now?
Re-think what your actual problem is. Define new rules so that there will be only one definite solution for a case like this. Otherwise you will get random results.
Probably you asked the wrong question.
Related
I'm sure this is explained somewhere but I can't seem to find out what I should search for.
I'm writing some code that lets the user input a number and the code should then do certain tasks that number of times. I only want to do this task to be done at a maximum of columns per row (lets say 10). Then start at the next row.
Right now I have a nested loop but I can't find a way to make it work with only one loop, instead I've had to create one loop for all rows that's complete (10 columns long) and then a single loop for the last row.
For i = 0 to numberOfCompleteRows
For j = 0 to numberOfColumns
tasks(j,i)
next j
next i
For x = 0 to numberOfColumnsAtLastRow
tasks(x,i+1)
next i
Is there a better way to do this?
(Sorry if there's some small errors in here, my actual code is not written for excel so didn't find a reason to post it as it was, tried to make it as standard as possible.)
If you loop from 1 to the TotalNumberOfRows, then the current column calculates as
CurrentColumn = (iRow - 1) \ NumberOfRowsPerColumn + 1
and the current row calculates as
CurrentRow = iRow - NumberOfRowsPerColumn * (CurrentColumn - 1)
Note that I used the \ Operator which is actually used to divide
two numbers and return an integer result and no normal division that
would use the normal / Operatior and return a floating-point
result.
So you end up with something like
Option Explicit
Public Sub WriteNumbersColumnWise()
Const TotalNumberOfRows As Long = 45
Const NumberOfRowsPerColumn As Long = 10
Dim iRow As Long
For iRow = 1 To TotalNumberOfRows
Dim CurrentColumn As Long
CurrentColumn = (iRow - 1) \ NumberOfRowsPerColumn + 1
Dim CurrentRow As Long
CurrentRow = iRow - NumberOfRowsPerColumn * (CurrentColumn - 1)
Cells(CurrentRow, CurrentColumn).Value = iRow
Next iRow
End Sub
To get the following output
I am working on a VBA script that sorts rows according to a couple of custom criteria. Since manipulating Excel rows is slow (big rows with various styles), I am doing the sorting through an object in memory:
Generate a jagged array representing the worksheet (containing only the relevant information used in the sorting process).
Sort the jagged array by applying a combination of quick-sort algorithm.
Regenerate the worksheet by using the sorted jagged array as a reference
Step 1 and 2 are only taking 0,84s to proceed (for my biggest worksheet). But the last step, re-generating the excel worksheet, takes a very long time: 129,11s in total !
Here is a simplified example of my code to regenerate the sheet:
Dim WS As Worksheet: Set WS = Worksheets("MySheet")
Dim EndRowIndex As Integer: EndRowIndex = WS.UsedRange.Rows.Count
Dim Destination As Integer: Destination = EndRowIndex + 1
Dim rowIndex As Integer
Dim i As Integer
For i = 1 To EndRowIndex
rowIndex = new_order_array(i)
WS.Rows(rowIndex).Copy
WS.Rows(destination).Insert Shift:=xlDown 'Copying the rows in the correct order at the bottom
destination = destination + 1 'incrementing the destination row (so it stays at the bottom)
Next
Application.CutCopyMode = False
WS.Rows("1:"& endRowIdex ).Delete 'Deleting the old unordered rows from the sheet
( new_order_array was generated in step 2, it has as many element as there are rows in the worksheet. It indicate which row need to be moved where: new_order_array(1) = 3, means that the row 3 need to become the row 1. )
As you can see, this is a simple but naive re-ordering. I copy every row in the correct order at the bottom, then delete every unordered row at the top.
In order to fully optimize the process, I would need to re-order the worksheet by using the minimal number of moves. Currently, regenerating a worksheet of N rows requires N copy-pasting, while moving rows cleverly would required at most N-1 moves. How can I find the smallest sequence of moves needed to re-order rows according to an array ?
I don't know were to begin my research for this task... are there existing algorithms on this subject ? Is this problem named (useful for keywords)? Did I miss something else that might improve performance (I have already disabled visual updates during the process)? Any help would be greatly appreciated.
Here's a fairly quick sorting algorithm in n steps.
The scrambled data:
'demo
Cells.Clear
Dim arr(1 To 100)
For i = 1 To 100
arr(i) = i
Next i
'scramble
Randomize
Dim rarr(1 To 100)
x = 100
While x > 0
r = Int(Rnd * x) + 1
rarr(101 - x) = arr(r)
arr(r) = arr(x)
x = x - 1
Wend
For i = 1 To 100
Cells(i, 1) = rarr(i)
Next i
The sort:
'sort
sp = 1 'start position
While sp < 101
If rarr(sp) = sp Then
WS.Rows(sp).Copy
WS.Rows(destination).Insert Shift:=xlDown
destination = destination + 1
sp = sp + 1
Else
d = rarr(rarr(sp))
rarr(rarr(sp)) = rarr(sp)
rarr(sp) = d
End If
Wend
For i = 1 To 100
Cells(i, 2) = rarr(i)
Next i
End Sub
The rarr array has been restored.
It works by swapping the first element with the element at the first element's position, and repeats this until the correct element is in position, copy/pastes it, and then moves onto processing element 2, and continues like this through the whole array.
It is guaranteed to work (on a contiguous set of integers 1..k) because once an element is in it's correct position, it is not referenced again.
I am looking for a marcro that can copy and paste cells.
The value of cell X must be copied to a cell X + 6.
So A1 text "Xteam" has to be copied to cell A7, this up to cell A380.
The same applies to cell B2 + 6.
It has to be dynamic, so the cell and sequence are dynamic..
I want to be able to indicate for myself which cell it is and the sequence ..
How can I do this,
I have this but doesnot work like i want:
Sub sequence()
Const Nxt As Long = 7
Dim A As Variant, B As Variant, V As Variant, N As Long
A = Range("A1").Value
B = Range("B2").Value
ReDim V(Nxt To 380, 1 To 2)
For N = Nxt To 380
If N Mod 6 = 1 Then
V(N, 1) = A
V(N + 1, 2) = B
End If
Next N
Application.ScreenUpdating = False
Range("A" & Nxt, "B380").Value = V
Application.ScreenUpdating = True
End Sub
thank you in advance
elmalle
Ok well, this is under the assumption that you want to specify how many times you want to copy A1 and B2 down the sheet. So your loop is fairly confusing, instead of using MOD, since you know you want it every 6 spaces and you're not doing anything to the other cells, it's easier just to have the number multiplied by 6 for your indexing. This also helps you figure out the dimensions of your transfer arrays more easily since you want to specify how many times you want to copy.
It's also worth noting that you're Application.screenupdating = False is in the wrong place. The real place you would want to speed up is during the loop. So if you were to include it, I would put it near the top of the code, but this isn't very resource intensive so I've just left it out.
Normally it's good to dim Constants if it helps with the legibility of the code, but in this case it doesn't seem to add any clarity. An example where it could help is where you're changing the colour of cells and are using colour indices. Constant Red as long = 3 makes it a lot more understandable, whereas constant Nxt as long = 7 doesn't add much.
Instead of working with a 2-D array dealing with both A and B at once, I chose to use two column vectors because it makes the pasting easier since they are staggered and it simplifies the math since you don't need to have items on staggered rows.
Lastly, I can't advocate this enough, but please, please, please use names that make sense at a glance. Although it may not have made a huge difference in this case, if you get to a more complicated project people might look at it and have to wonder what V is even used for. It also just makes it easier for people to help you since they won't have to sit for a bit wondering what each variable means.
I've also specified the worksheet it looks at, so currently it'll only look at the first sheet as indicated by the index 1. Make sure you change that so it changes the correct sheet.
Hope this helped and welcome to Stack Overflow.
Option Explicit
Sub sequence()
Dim A As Variant
Dim B As Variant
Dim N As Long
Dim ArrA() As Variant
Dim ArrB() As Variant
Dim NumCopies As Long
A = Range("A1").Value
B = Range("B2").Value
NumCopies = 100
ReDim Preserve ArrA(1 To NumCopies * 6, 1 To 1)
ReDim Preserve ArrB(1 To NumCopies * 6, 1 To 1)
For N = 1 To NumCopies
ArrA(N * 6, 1) = A
ArrB(N * 6, 1) = B
Next N
Worksheets(1).Range("A2:A" & 1 + NumCopies * 6).Value = ArrA
Worksheets(1).Range("B3:B" & 2 + NumCopies * 6).Value = ArrB
End Sub
My formula below subtracts a cell until it reaches zero, and moves to the next one. The subtraction is based on the value “B”. Each time the formula comes across the value “B”, this action is performed.
Question: I have been trying to advance this to formulae, in that each time “B” is found that cell is minuses until zero and those amount multiple by the adjacent price.
could you please provide me with a formula which does this ?
Example: when it comes across the first B the full value of 100 x 10 will be multiplied and the reminder 50 will be multiplied by 15 i.e. 50 x 15 price of the next A. These values will be summed.
=MAX(SUMIF($A$2:A2,"A",$B$2:B2)-SUMIF($A$2:$A$10,"B",$B$2:$B$10),0)
The reminder of the 50 is coming from the difference between the B 150 - A 100 , which leaves 50 to be still absorbed .
Further Calculation for explanation:
Apologies thats meant to say calculation of 6000
Your question is still very unclear. What does "My formula below subtracts a cell until it reaches zero" mean? Also, as OldUgly pointed out, it seems that you are ignoring the second A. Since we can't understand each other, take a look at the code below and try to rewrite it yourself to fit your needs. It assumes the data is in a sheet named "Data", and that there is a button (Button1) to run the code.
Dim lLastRow As Long
Dim i As Integer
Dim QtyNumberA, QtyNumberB, QtyNumberRem As Integer
Sub Button1_Click()
lLastRow = Worksheets("Data").Cells(2, 1).End(xlDown).Row 'Rows with data, starting 2nd row (titles in the first)
QtyNumberA = 0 'Variable for storing quantities of A
QtyNumberB = 0 'Variable for storing quantities of B
QtyNumberRem = 0 'Variable for storing quantities remaining
For i = 2 To lLastRow 'scan all rows with data
If (Worksheets("Data").Cells(i, 1).Value = "A") Then
QtyNumberA = QtyNumberA + Worksheets("Data").Cells(i, 2).Value
ElseIf (Worksheets("Data").Cells(i, 1).Value = "B") Then
QtyNumberB = QtyNumberB + Worksheets("Data").Cells(i, 2).Value
QtyNumberRem = QtyNumberA - QtyNumberB
Worksheets("Data").Cells(i, 6) = QtyNumberRem
End If
Next
End Sub
I want to create a list of all possible percentage splits between different number of stocks (a task required to build a proper investment opportunity set). I was able to create a macro tailored for 3 different inputs (the code is below).
Is it be possible to upgrade that macro so that it will automatically take into consideration the number of inputs (i.e. stock tickers) without the necessity to adjust the code every time? So that if input is 5 tickers instead of 3, it will create the list of all possible splits for 5 tickers?
Spreadsheet layout is simple: in row 1 I have a separate ticker in each column (3 tickers at the moment), and the split is provided below as:
ColumnA ColumnB ColumnC
row1 Ticker1 Ticker2 Ticker3
row2 0 0 100
row3 0 1 99
etc.
Here's what I'm using for 3 inputs:
Sub PercentageSplits()
Dim Lastcol As Integer
Lastcol = Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column
Sheet1.Cells(1, Lastcol + 1).Value = "Total"
Sheet1.Cells(1, Lastcol + 1).Font.Bold = True
Dim row As Integer: row = 2
Dim i As Integer, j As Integer, k As Integer
For i = 0 To 100: For j = 0 To 100: For k = 0 To 100
If i + j + k = 100 Then
Sheet1.Cells(row, 1).Value = i
Sheet1.Cells(row, 2).Value = j
Sheet1.Cells(row, 3).Value = k
Sheet1.Cells(row, Lastcol + 1).Value = i + j + k
row = row + 1
End If
Next: Next: Next
End Sub
I put a quick program together to calculate these and for a total of 100 split across 5 tickers, I got more than 4.5 million results (4,598,126 to be precise). That's way too many to fit on an Excel sheet.
To make sure that the output would fit on an Excel sheet, I halved the precision by calculating combinations of 5 tickers which added to 50 and then doubling the results. This gives 316,251 results.
If you need full precision then you could adapt the code to output the data in chunks of 1 million rows per worksheet
I don't often use recursion in VBA but it seemed the obvious way to answer this particular question. I'll explain some details below the code:
Option Explicit
' We'll store each result here
Dim splitList As Collection
Sub main()
Dim splitResult As Variant
Dim splitArray As Variant
Dim splitEntry As Variant
Dim outputArray() As Variant
Dim outputRow As Long
Dim outputCol As Long
' Initial set-up
Const TOTAL_TO_SPLIT As Integer = 50
Const NO_OF_TICKERS As Integer = 5
Set splitList = New Collection
' Generate the list
findSplit TOTAL_TO_SPLIT, 1, NO_OF_TICKERS, ""
MsgBox splitList.Count
' Output the list
ReDim outputArray(1 To splitList.Count, 1 To NO_OF_TICKERS)
outputRow = 1
With Worksheets("Sheet1")
.UsedRange.Clear
For Each splitResult In splitList
outputCol = 1
If Len(splitResult) > 0 Then
splitArray = split(splitResult, ";")
For Each splitEntry In splitArray
outputArray(outputRow, outputCol) = splitEntry * 2
outputCol = outputCol + 1
Next splitEntry
End If
outputRow = outputRow + 1
Next splitResult
.Cells(2, 1).Resize(splitList.Count, NO_OF_TICKERS).Value = outputArray
End With
End Sub
' This sub is intended to be called recursively and will add an entry
' to splitList after each recursion concludes
Sub findSplit(amountToSplit As Integer, currentTicker As Integer, _
totalTickers As Integer, resultSoFar As String)
Dim i As Integer
' Call DoEvents to prevent Excel from showing as "Not Responding"
DoEvents
' Check if this is the last ticker
If (currentTicker = totalTickers) Then
splitList.Add resultSoFar & amountToSplit
Else
For i = 0 To amountToSplit
' Otherwise, generate all the possible splits by recursion
findSplit (amountToSplit - i), (currentTicker + 1), _
totalTickers, (resultSoFar & i & ";")
Next i
End If
End Sub
Notes:
this is not going to run quickly. I suggest that you bring up the Locals window (View > Locals window) in the Visual Basic editor before running the macro so you can periodically use Ctrl-Break to check on progress
you could eliminate the collection and just write directly into the 2D array but I was trying to keep the recursive part of the code as simple as possible
It's probably easiest to understand the recursive sub (findSplit) by working backwards. If we are on the final ticker (so currentTicker = totalTickers) then we only have one possibility: the amount left over after all of the previous tickers needs to be allocated to the final ticker.
If we back up a level, if we are on the second-last ticker and the amount left over is 1 then we have two choices. Allocate 0 to the second-last ticker and pass 1 on to the last ticker OR allocate 1 to the second-last ticker and pass 0 on to the last ticker. Extending things to more tickers and/or greater amounts is just a repetition of these same two rules:
if this is the last ticker, allocate whatever's left to this ticker
if this is not the last ticker, try every possible allocation of whatever was left to this ticker and pass whatever is left over on to the next ticker
Each ticker adds the amount it was allocated to a string which is added to the collection by the last ticker. An entry of 14;6;0;13;17 shows that the ticker 1 was allocated 14, ticker 2 was allocated 6 and so on. As stated above, I reduced the number of results by calculating allocations against a total of 50 and then doubled the result. So the 14;6;0;13;17 combination would output as 28;12;0;26;34 (and you'll find it in row 228559 on the output worksheet).
The code in the main sub using Split and the For Each ... Next loops converts the strings stored in the collection into a 2D array of numbers that we can drop directly on to the worksheet