I have a large set of data on which I need to obtain a set of values that reach to a desired number. To be more precise, I have supermarket tickets each of them with one ID number and the amount that was charged to the customer.
I have to pick up tickets that add to a specific number (let's say 1,000,000 USD). I tried using solver where in one column you use a binary 1/0 variable and then just sumif to get the ones that solver selects that add up to the target value of 1M. However, this works when the sample is small. The file i just got has over 280,000 tickets, so there is no way solver can handle that number of binary variables.
How can I get in one column the number of tickets that add up to 1,000,000? I tried using a "while" loop but my computer crashes after 5 min or so. Any ideas?
Thanks!
Is this what you want? Enter the logic in A1:A11.
=RANDBETWEEN(1,50)
=IFERROR(RANDBETWEEN(1,100-SUM($A$1:A1)),0)
=IFERROR(RANDBETWEEN(1,100-SUM($A$1:A2)),0)
=IFERROR(RANDBETWEEN(1,100-SUM($A$1:A3)),0)
=IFERROR(RANDBETWEEN(1,100-SUM($A$1:A4)),0)
=IFERROR(RANDBETWEEN(1,100-SUM($A$1:A5)),0)
=IFERROR(RANDBETWEEN(1,100-SUM($A$1:A6)),0)
=IFERROR(RANDBETWEEN(1,100-SUM($A$1:A7)),0)
=IFERROR(RANDBETWEEN(1,100-SUM($A$1:A8)),0)
=IFERROR(RANDBETWEEN(1,100-SUM($A$1:A9)),0)
=SUM(A1:A10)
Result
Or, maybe this. Enter this in A1:A41
8
6
3
2
6
10
9
4
12
8
6
1
8
10
8
14
10
9
12
12
14
6
4
3
4
4
4
0
6
10
4
9
6
3
11
12
10
7
12
8
8
Put 92 in cell B1, and run this VBA.
Sub FindSeries()
Dim StartRng As Range
Dim EndRng As Range
Dim Answer As Long
Dim TestTotal As Long
Answer = Range("B1") '<<< CHANGE
Set StartRng = Range("A1")
Set EndRng = StartRng
Do Until False
TestTotal = Application.Sum(Range(StartRng, EndRng))
If TestTotal = Answer Then
Range(StartRng, EndRng).Select
Exit Do
ElseIf TestTotal > Answer Then
Set StartRng = StartRng(2, 1)
Set EndRng = StartRng
Else
Set EndRng = EndRng(2, 1)
If EndRng.Value = vbNullString Then
MsgBox "No series found"
Exit Do
End If
End If
Loop
End Sub
Related
I would like to thank everyone for their feedback so far it has helped a great deal. one question that I am grappling with is how to make my column values even so I can do a dynamic subtototal.
Column k Column R Column Y Column AF Column AM Column AT
1 2 4 2 3 5
3 9 7 8 2 4
2 3 6 3 5 8
3 3 2
5
TOT 9 14 25 13 12 17
Column k Column R Column Y Column AF Column AM Column AT
1 2 4 2 3 5
3 9 7 8 2 4
2 3 6 3 5 8
3 3 2
5
TOT 9 14 25 13 12 17
on a monthly basis the column values can fluctuate, the question is how do I use VBA to create a dynamic sum based on the column with the most values.
Dim Rin As Range
Dim Rout As Range
Dim lRa As Long
lRa = Range("i" & Rows.count).End(xlUp).Row
Set Rin = ws.Range("i" & lRa)
Set Rout = ws.Range("I" & lRa)
aCell.Range("I11:P12", "R12:AY12").Copy
Rout.Offset(2, 0).Resize(1, 28).Formula = "=SUBTOTAL(9," &
Rin.Address(0, 0) & ")"
lR = ws.Range("I" & Rows.count).End(xlUp).Row - 1 ' Finds the last blank
row
ws.Range("I" & lR).PasteSpecial xlPasteFormats
If you know where your data starts you can use a method such as that given by Shai Rado.
You can't have any entirely empty rows or columns in the range.
You can then feed this lastRow variable into the range address for adding your subtotal formula.
Example: If your data is a continuous set of populated columns starting at Cell D3 the following will get the last used row number in the range of columns:
Option Explicit
Public Sub AddSubTotal()
Dim lastRow As Long
Dim lastCol As Long
Dim firstRow As Long
Dim rowHeight As Long
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Sheet2") 'change as appropriate
With ws.Range("D3").CurrentRegion 'change as appropriate
firstRow = .Rows(1).Row
lastRow = .Rows(.Rows.Count).Row
lastCol = .Columns(.Columns.Count).Column
rowHeight = lastRow - firstRow + 1
End With
With ws
.Range(.Cells(lastRow + 1, "D"), .Cells(lastRow + 1, lastCol)).FormulaR1C1 = "=SUBTOTAL(9,R[-" & rowHeight & "]C:R[-1]C)"
End With
End Sub
If you need a different method to find the last used row and last used column there a lots of available resources online including my favourite by Ron De Bruin Find last row, column or last cell. The appropriateness of each method is determined by the shape and properties of your range e.g. no blank columns or rows in range. So choose a method that is right for your data or that can test for different likely cases and apply different methodologies as appropriate.
It is quite difficult to give a definitive answer (and i don't want to code lots of different possible scenarios) to this question without knowing more about the nature and variability of the data. If you familiarise yourself with the methods of finding last row and column you will be able to implement those that suit your needs.
I have an excel sheet with data arranged randomly with numbers and letters throughout Columns B and C. I also have an input cell located in cell "O7" and an output cell located in "P7" where a user can input any value (1,1a, 2,2b, etc...) and the code will use these values to find and copy the value in A
My code (below) runs through and finds the value in B based on the value in "O7" and copies the corresponding value in column A (2 times) for that row to "Sheet4." It then looks to the next cell in column C and uses that value to find the next row in Column B with that value. Then it copies that row's value in Column A to Sheet 4 under the previous one.
My problem is that my code can't distinguish between "1" and a value with a letter like "1a" for either the input or output value. It just sees that there is a "1" and copies the value in A. I believe I may not be setting my NewStart variable as the next value to look up correctly or my function may be missing something to distinguish between "1" and "1a"?
Sub NewerFind()
Dim Startval As Long
Dim Endval As Long
Dim LastRow As Long
Dim Rng As range
Dim Output As Long
Dim NewStart As Long
Dim Val As Long
Dim Valnew As Long
LastRow = Sheets("Sheet3").range("B" & Rows.Count).End(xlUp).Row
Startval = GetSingleFromString(Sheets("Sheet3").Cells(7, "O").Value)
Output = 2
NewStart = Startval
For X = 7 To LastRow
Val = GetSingleFromString(Sheets("Sheet3").Cells(X, 2).Value) 'if i set the variables equal to a string, do i need the GetSingleFromString function?
Valnew = GetSingleFromString(Sheets("Sheet3").Cells(X, 3).Value)
Endval = GetSingleFromString(Worksheets("Sheet3").Cells(7, "P").Value)
If Val = Endval Then
Exit Sub
ElseIf Val = NewStart Then
Sheets("Sheet4").Cells(Output, 1).Value = _
Sheets("Sheet3").Cells(X, 1).Value
Output = Output + 1
Sheets("Sheet4").Cells(Output, 1).Value = _
Sheets("Sheet3").Cells(X, 1).Value
Output = Output + 1
NewStart = Valnew
End If
'need line of code to set NewStart as the value of the cell to the right...???????
Next X
End Sub
This is the function I'm using to enable the code to include cells with letters. Without it, it skips cells with letters:
Private Function GetSingleFromString(ByVal InString As String) As Single
If Len(InString) <= -1 Then
GetSingleFromString = -1
Exit Function
End If
Dim X As Long
Dim Temp1 As String
Dim Output As String
For X = 1 To Len(InString)
Temp1 = Mid(InString, X, 1)
If IsNumeric(Temp1) Or Temp1 = "." Then Output = Output & Temp1
Next
If Len(Output) > 0 Then
GetSingleFromString = CSng(Output)
Else
GetSingleFromString = -1
End If
End Function
This is my excel Sheet:
A B C D E
1 1 1a 78.15 77.68 (Row 7)
2 1a 2 77.18 76.92
3 2 3 76.92 76.63
4 3 4 76.13 75.78
5 4 4a 75.78 75.21
6 4a 5 75.11 74.87
7 5 5a 74.87 74.69
8 5a 6 73.94 73.6
9 6 6a 73.1 72.71
10 6a 6b 72.41 72.18
11 6b 10 72.18 71.6
12 10 11 71.3 70.89
13 11 12 70.89 69.83
14 12 13 69.83 68.68
15 13 14 68.68 67.68
16 14 15 67.63 66.46
17 15 16 66.01 64.84
18 16 16a 64.24 63.72
19 16a 16b 56.82 56.37
20 16b 16c 56.37 55.18
21 16c OUT 47.28 47.27
22 7 7a 83.12 76.07
23 7a 8 76.17 75.99
24 8 9 74.79 74.41
25 9 6 74.51 74 (Row 31)
Thank you in advance for the help.
It's not clear what you're trying to do; all I can see is that you want to find cells with a matching value, which may be the entire value, or just the numeric part of a value.
What I do know is that Range.Find isn't as useful as you think: it sometimes makes a string comparison if either the search value or the seek range is a string, and sometimes decides it's 'no match' if tries the numeric value 1 against the string "1", depending on the formatting in the cells.
It'll definitely treat "1" versus "1a" as 'no match', if you've set LookAt:=xlWhole, because you've specified that the whole of the value, each and every character, must match the search string exactly.
That's fine, most of the time, if you wanted to treat "1" versus "1a" as 'no match', and only match "1"to "1" and "1a to "1a".
If you wanted to treat "1" versus "1a" as a 'find', you have two choices:
Use the partial match option in Range.Find by setting
LookAt:=xlPart, and hope that it doesn't get confused by formatting. And most of the time, it doesn't get confused; so you're probably fine.
Search through the cells in each range with VBA, using 'Like', which allows you to specify partial matches, single digits, and match-from-the-list for specific characters like [1234567890]
Just to get you started with 'Like':
"1" = "1a" returns False
"1" LIKE "1a" returns False
"1" LIKE "1*" returns True, although this isn't a very useful thing to know
"1a" LIKE "#*" returns True, and this looks a bit more relevant because you've identified a value that starts with a number, and you can test that at the top of an If... Then block containing further logic to make the match you actually want.
Full documentation for the 'Like' operator is here on MSDN:
https://msdn.microsoft.com/en-us/library/office/gg251796.aspx
Developers using other languages will use Regular Expressions for this kind of thing: but you'd need to import an external Regex library for that, as it isn't native to Excel and VBA.
Also: a string can never have a LEN of less than zero. Your test If Len(InString) <= -1 Then needed to be for zero, or less than 1.
I have a large data set that I have managed to arrange in the following format as an example:
A A
One 1
Two 2
Three 3
Four 4
Five 5
Six 6
Seven 7
B B
One 1
Two 2
Three 3
Four 4
Five 5
Six 6
C C
One 1
Two 2
Three 3
Four 4
Five 5
Six 6
Seven 7
Eight 8
I would like to split the data into separate columns...like this:
A A B B C C
One 1 One 1 One 1
Two 2 Two 2 Two 2
Three 3 Three 3 Three 3
Four 4 Four 4 Four 4
Five 5 Five 5 Five 5
Six 6 Six 6 Six 6
Seven 7 Seven 7
Eight 8
This is one of the last steps in getting my data into a usable format. I am already employing various VBA macros to get the data into the first format. I hit a roadblock with this next major step. I have done some extensive googling and have not been able to come with the right macro. Thank you for your help.
Assuming no other frills and you're headers being more than just A, B, or C, I'd use the following macro. Just to be clear, this is highly inflexible. It will only work if you've got exactly the same setup as above, so it's up to you to apply the logic I used and modify it to suit your needs.
Sub NoFrills()
Dim aRng As Range, bRng As Range, cRng As Range
Dim endA As Long, endB As Long, endC As Long
Dim aRngToCopy As Range, bRngToCopy As Range, cRngToCopy As Range
Dim NextCol As Long, RngToCopy As Range
Set aRng = Columns(1).Find(What:="Alpha")
Set bRng = Columns(1).Find(What:="Beta")
Set cRng = Columns(1).Find(What:="Charlie")
'endA = bRng.Offset(-1, 0).Row 'Not really needed.
endB = cRng.Offset(-1, 0).Row
endC = cRng.End(xlDown).Row
'Set aRngToCopy = Range(aRng, Cells(endA, 2)) 'Not really needed.
Set bRngToCopy = Range(bRng, Cells(endB, 2))
Set cRngToCopy = Range(cRng, Cells(endC, 2))
Application.ScreenUpdating = False
NextCol = aRng.End(xlToRight).Offset(0, 1).Column
bRngToCopy.Cut Cells(1, NextCol)
NextCol = aRng.End(xlToRight).Offset(0, 1).Column
cRngToCopy.Cut Cells(1, NextCol)
With Application
.CutCopyMode = False
.ScreenUpdating = True
End With
End Sub
My approach here is to determine ahead of time all the "blocks" of cells needing to be cut and transferred into the horizontal format. Then, I keep on determining the next column that needs to be targeted by calling NextCol again and again and pasting to that cell.
The logic, of course, is that you've got more ranges, you have to store these ranges somewhere (hint, hint) and loop over them (more hint, hint).
Let us know if this helps or at the very least points you in the direction you want.
Screenshots:
Set-up:
Result:
Dim i As Long
Dim rows As Long
Dim rng3 As Range
rows = rng3.rows.Count
For i = rows To 1 Step (-1)
Does anyone know how this loop works? I'm confused on the meaning of rows To 1 Step (-1).
from high number To 1 adding (-1) each iteration
Note: It's adding because + AND - in mathematical logic evaluate to a -
If rows = 10 then
for i = 10 to 1 step -2 would mean loop back from 10 to 1 subtracting 2 from the i in each loop cycle.
adding a Debug.Print i inside the loop may give you a better clue.
Note: turn ON the Immediate Window hitting CTRL+G or View => Immediate Window from the VBE menu bar
An example loop increasing by 3 on each cycle.
for i = 1 to 10 step 3
debug.print i
next i
Usage
The step-back technique is mostly used when deleting rows from a spreadsheet.
To see the logic in practice see the following
How to select and delete every 3rd column
Delete entire excel column if all cells are zeroed
Excel VBA - Scan range and delete empty rows
When deleting rows, it is often common practise to start at the end and step backwards, this is so no rows are skipped.
Dim i As Long
Dim rows As Long
Dim rng3 As Range
rows = rng3.rows.Count
For i = rows To 1 Step (-1)
'delete row if "delete" is in column 1
If rng3.cells(i,1).Value = "delete" Then
rng3.Rows(i).EntireRow.Delete
End If
next i
Dim i as Integer
For i = 1 To 14 Step 3
Debug.Print i
Next i
In above code loop will iterate from 1 to 14 increment with 3 so output will be like
1 4 7 10 13
It means it can not cross 14 that is limit.
So whatever value is provided in step it will add into the variable use for looping purpose. Here
i = i +3
But in For loop in VBA, Step value can not be changed dynamically. For example:
Dim i As Integer
For i = 1 To 10 Step i
Debug.Print i
Next i
Here, before starting iteration Step is equal to the value of i that is the default value i.e. 0. So i will increment like below:
i = i+ i => i = i+0
So i will not increment here and loop will iterate for ever.
Now for below code:
Dim i as Integer
For i = 1 To 14 Step i+1
Debug.Print i
Next i
i will increment like :
i=i+(i+1) => i= i+(0+1) =>i = i+1
so it will increment by 1 and output will be 1 2 3 .... 14
Now for below code :
Dim i As Integer
i = 3
For i = 1 To 10 Step i
Debug.Print i
Next i
here, i is equal to 3 before loop execution, so Step value will be 3, but loop will start with i = 1 and will increment with 3 through out the loop.
here,
i = i+3
so output will be 1 4 7 10.
Now for some other variable:
Dim i As Integer
Dim j As Integer
j = 2
For i = 1 To 10 Step j
Debug.Print i
j = i
Next i
in above code Step value will be 2, so i will increment by 2 for every iteration whether j is modifying inside loop or not, it will not impact Step value, so output will be
1 3 5 7 9
Please correct me if I miss anything or something is wrong in this. Also suggest if there is any way for dynamic looping using For loop in VBA.
This question already has answers here:
Closed 10 years ago.
Possible Duplicate:
Insert row every X rows in excel
I have a large set of data (let's say it goes from B5 to J500 and let's say this range is named rngOutput). I am trying to go through this data and add 2 empty rows every x number of rows where x is a number the user specifies. For example if x is 10 then every 10 rows 2 new rows should be inserted. Conceptually, this is the code that should work:
For i = 1 to Number of rows in rngOutput
If i mod x = 0 Then
Insert 2 Rows
End If
Next i
However, when you insert 2 new rows, the row count changes and the formula messes up (i.e. it adds 2 rows after the first 10 rows, then it adds another 2 rows after the next 8 rows (since it counts those 2 new rows you added as actual rows) then it adds another 2 rows after the next 6 rows, etc.
I am trying to figure out a way to accomplish adding 2 new rows every x number of rows cleanly to avoid the above problem.
Thank you for the help and please let me know if you need additional clarification!
This is like Chris's only fleshed out. When inserting or deleting rows you have to work up from the bottom:
Sub InsertXRowsEveryYRows_WithMeaningfulVariableNames()
Dim NumRowsToInsert As Long
Dim RowIncrement As Long
Dim ws As Excel.Worksheet
Dim LastRow As Long
Dim LastEvenlyDivisibleRow
Dim i As Long
NumRowsToInsert = 2 'any number greater than 0
RowIncrement = 10 'ditto
Set ws = ActiveSheet
With ws
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
LastEvenlyDivisibleRow = Int(LastRow / RowIncrement) * RowIncrement
If LastEvenlyDivisibleRow = 0 Then
Exit Sub
End If
Application.ScreenUpdating = False
For i = LastEvenlyDivisibleRow To 1 Step -RowIncrement
.Range(i & ":" & i + (NumRowsToInsert - 1)).Insert xlShiftDown
Next i
End With
Application.ScreenUpdating = True
End Sub
Count from the bottom of the range
For i = Number of rows in rngOutput to 1 step -1
If i mod x = 0 Then
Insert 2 Rows
End If
Next i