I am developing a program in analyzing data. I am very new to Visual Basics and Macros. I have 2 columns A and B that has values between .001 and 1. I need help creating bins to store these numbers. I've done research and looked at so many example programs, nothing remotely close to what I need.
Here're a few important details. Column A has needed data from A1 to A2625 and column B has needed data from B1 to B2700. I need to put this data in into 10 bins. Ex: Bin 1 needs to hold values .001 to .11, Bin 2- .12-.20.....until bin 10. Any suggestions? Thank You!
You don't need VBA to do this. There is a function in Excel called Frequency. If you have numbers in one columns you make your bins in another column like this
+--------+------+
| values | bins |
+--------+------+
| 59 | 0 |
| 16 | 10 |
| 12 | 20 |
| 5 | 30 |
| 33 | 40 |
| 90 | 50 |
| 92 | 60 |
| 74 | 70 |
| 26 | 80 |
| 63 | 90 |
| 40 | 100 |
| etc| |
+--------+------+
then you can use
FREQUENCY(values,bins)
I needs to be entered exactly like this though because it is an array formula:
Notice I have all of the cells adjacent to the bins selected and I am in edit mode in the top cell. Then once the formula is written you hit ctrl+alt+enter and all the cells you selected will fill in with the number of occurrences for that bin.
This will work with multiple columns.
To make a histogram graph bins v frequency.
What this won't do is create bins for you.
In VBA you'll create a macro that is something along the lines of
Option Explicit
Sub myMacro()
Dim nRow As Integer
Dim wSht As Worksheet
Dim endRowColumn1 As Integer
Dim endRowColumn2 As Integer
Set wSht = ActiveWorkbook.Sheets(1)
endRowColumn1 = wSht.Cells(Rows.Count, 1).End(xlUp).Row
endRowColumn2 = wSht.Cells(Rows.Count, 2).End(xlUp).Row
' Clear results from last run
wSht.Range("C:E").Clear ' Clear rows 3,4,5
wSht.Cells(1, 3) = "Bin1"
wSht.Cells(1, 4) = "Bin2"
wSht.Cells(1, 5) = "No Criteria Met"
' STARTING WITH SECOND ROW
For nRow = 2 To endRowColumn1 ' For each row... to the end of your rows..
' If the first bin criteria is met...
If (wSht.Cells(nRow, 1) >= 0.001) And _
(wSht.Cells(nRow, 1) < 0.12) Then
' Then put the value into the first bin. (column C)
wSht.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0) = wSht.Cells(nRow, 1)
ElseIf (wSht.Cells(nRow, 1) >= 0.12) And _
(wSht.Cells(nRow, 1) < 0.2) Then
' Then put the value into the second bin. (column D)
wSht.Cells(Rows.Count, 4).End(xlUp).Offset(1, 0) = wSht.Cells(nRow, 1)
Else ' No Criteria Met
wSht.Cells(Rows.Count, 5).End(xlUp).Offset(1, 0) = wSht.Cells(nRow, 1)
End If
Next nRow
For nRow = 2 To endRowColumn2 ' For each row... to the end of your rows..
' If the first bin criteria is met...
If (wSht.Cells(nRow, 2) >= 0.001) And _
(wSht.Cells(nRow, 2) < 0.12) Then
' Then put the value into the bin. (column C)
wSht.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0) = wSht.Cells(nRow, 2)
ElseIf (wSht.Cells(nRow, 2) >= 0.12) And _
(wSht.Cells(nRow, 2) < 0.2) Then
' Then put the value into the second bin. (column D)
wSht.Cells(Rows.Count, 4).End(xlUp).Offset(1, 0) = wSht.Cells(nRow, 2)
Else ' No Criteria Met
wSht.Cells(Rows.Count, 5).End(xlUp).Offset(1, 0) = wSht.Cells(nRow, 2)
End If
Next nRow
End Sub
Please let me know if you have questions about the code and we can discuss it.
Related
I have about 100 rows that include a random number generator in a column and in another column with calulations=A based on that random number and other things. I have set up a column with an if statement to examine if A is within an upper and lower range which returns a "1" if true (a hit, if you will) and "0" if not. I want to run a loop and count the number of hits over time in these cells. Essentially i need a column that acccumulates the results so in the end I can see what range has the most hits, etc.
To make it simpler, let's first say your data is stored as follows, before we start, on your worksheet "ws":
A | B | C
1 Random Numbers | Calculated Value | Accumulated Value
2 0 | 1 |
3 5 | 0 |
4 8 | 1 |
5 73 | 0 |
6 2 | 0 |
[...]
And let's say we want to run this process 10,000 times to see which rows get the highest accumulated values, represented as the sum of the calculated value from each of the previous iterations. I would suggest the following VBA solution:
Sub AccumulateValues
Dim MaxIterations As Long: MaxIterations = 10000
Dim curRow as Long, LastRow as Long, it as Long
Application.Calculation = xlCalculationManual 'Required to set it to manual
With ws
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
For it = 1 to MaxIterations
'Force the Recalculation of Cells in columns A and B:
Application.Calculate
For curRow = 2 To LastRow
'Sum the result of this iteration with the accumulated value
'until the previous iteration and stores it.
ws.Cells(curRow, 3) = ws.Cells(curRow, 3) + ws.Cells(curRow, 2)
Next curRow
Next it
End With
End Sub
I have 256 columns in a excel sheet. I need to bring them to 128 columns by merging pairs of columns. How can I repeat the process of concatenating two cells throughout the sheet
Eg:
Col | Col2 | Col3 | Col4
1: | 45 | 2: | 556
1: | 34 | 2: | 567
Now my expected result is
Col1 | Col2
1:45 | 2:556
1:34 | 2:567
How can I perform this in Excel?
Can I use VBA?
Add two columns with the simple formula =A2&B2. Copy down. then copy resulting formula columns and paste special values to get rid of formula.
Assuming that range is "A1:IV1000" (change to what you need). In the end the original range is cleared and resulting array is dumped.
Sub ConcatColumns()
Dim rng As Range
Dim x As Long, c As Integer, z As Integer
Dim arr, arrResult
Const COLS As Integer = 256
Set rng = Range("A1:IV100") '//256 columns
arr = rng.Value
ReDim arrResult(1 To UBound(arr, 1), 1 To COLS / 2)
For x = 1 To UBound(arr, 1)
z = 1
For c = 1 To COLS - 1 Step 2
arrResult(x, z) = arr(x, c) & arr(x, c + 1)
z = z + 1
Next
Next
rng.ClearContents '//Clear all previous data
Range("A1").Resize(UBound(arrResult, 1), UBound(arrResult, 2)).Value = arrResult '//Dump result
End Sub
Using the formula (in cell A4 in image below)
=OFFSET(A1, , COLUMN()-1)&OFFSET(B1,,COLUMN()-1)
I have a large data set which looks like this:
Employee ID |Job| Function| Level|Date of change
1 | x | a | A1 | 01/05/2014
1 | y | a | A1 | 02/04/2015
1 | y | a | A2 | 25/08/2015
1 | z | a | A3 | 27/12/2015
1 | z | c | A3 | 01/03/2016
2 | t | b | B1 | 12/05/2013
2 | v | b | B1 | 13/04/2014
2 | w | b | B3 | 12/01/2016
Each row contains a change in either job, function or level.
I need to create a table which puts together the latest change in level for each employee (so for employee 1, it would be row 4). So far I have used a combination of conditional formatting and pivots but I was wondering if there is a way to do this quicker in VBA.
Thanks!
Without VBA
This assumes that there are genuine dates in column E with format dd/mm/yyyy, In G1 enter the Array Formula:
=MAX(IF(A:A=1,E:E,""))
This gives the latest date for employee 1
Array formulas must be entered with Ctrl + Shift + Enter rather than just the Enter key.
Then in G2 enter:
=SUMPRODUCT(--(A1:A9=1)*(E1:E9=G1)*(ROW(1:9)))
This gives the row number of the record you are interested in.
From there you can use INDEX() to get any information from that row.
NOTE:
The formulas in G1 and G2 can be combined into a single cell if desired.
EDIT#1:
The same set of formulas should work with text values for the employee id as well as numbers:
Not sure this is the best solution, but since this is a one-off exercise and it did the trick I used this:
VBA to find all the rows where there was a change in level, and write a "yes" in column "F" where applicable:
Sub JLChange()
Dim Data As Worksheet
Dim i As Long
Dim lastrow As Long
Set Data = ThisWorkbook.Worksheets("Data")
lastrow = Data.Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lastrow
If Cells(i + 1, 4).Value <> Cells(i, 4).Value And_
Cells(i + 1,1).Value = Cells(i, 1).Value Then
Cells(i + 1, 6).Value = "Yes"
Else
Cells(i + 1, 6).Value = "No"
End If
Next i
End Sub
For all the records in column "F", I used the formulas suggested by Gary's student to get the very last change.
Alternatively, you can copy-paste this database of changes in a new sheet, sort by ID and by date of change from newest to oldest, then use vlookup to get the first entry for each ID.
I am currently trying to write a short loop to condense a list of received items into a concise itemized report. I scan the barcode of each item I receive and it goes into Column A, if there is a quantity of more than 1 it goes into Column B.
Here is my thought process in order to remove all duplicates of items in column A and combine their totals in B:
Count the numbers of lines in column A, set as 'N'
Check all cells in column B up to 'N' and set blank cells to 1
Compare A1 to A2 thru AN, if the same combine B values and delete the line (If A1 and A2 matched, and both B cell values are 1, then A1 remains the same, B1 now has a value of 2, and the second line gets deleted.)
Repeat the loop for all values of A up to AN-1 compared to AN.
I know N will need to be reduced after each row deletion and I am pretty new to VBA so I always have trouble writing loops.
Any suggestions at pages to look at or simple structures I could use in my code would be greatly appreciated.
EDIT: Trying to turn table 1 into table 2
Table 1 ----------------------------- Table 2
Column A Column B | Column A Column B
11233 | 11233 4
11233 2 | 9987 7
9987 | 7452 1
11233 |
9987 6 |
7452 |
Sub Summator()
ActiveSheet.Columns("A:B").Sort Key1:=ActiveSheet.Range("A2"), Order1:=xlAscending, Header:=xlGuess
lastRow = Range("A65000").End(xlUp).Row
For i = 1 To lastRow
If Cells(i, 2) = "" Then Cells(i, 2) = 1
Next i
For i = lastRow To 2 Step -1
If Cells(i, 1) = Cells(i - 1, 1) Then
Cells(i - 1, 2) = Cells(i - 1, 2) + Cells(i, 2)
Cells(i, 2).EntireRow.Delete
End If
Next i
End Sub
Language: Excel VBA
Scenario:
I have a source range (rngDTRef_AllRecord) that i need to insert the data into the destination range (rngRTDC_AllDetail)
for each of the row(rngCurrRow) in the source range (rngDTRef_AllRecord), it will filter the destination range (rngRTDC_AllDetail)
if the filter yield result, it will add some data to the result row (Note: each of the result is unique)
else it will add a new row to the destination range (rngRTDC_AllDetail)
below is the code:
For Each rngCurrRow In rngDTRef_AllRecord.Rows
intRTDC_RowBegin = 7
intRTDC_ColIdxTotal = 20
intRTDC_RowLast = fntGetNewLastRow 'this is some function get last row of rngRTDC_AllDetail due to might add in new row
Set rngRTDC_AllDetail = shtRTDC.Range(shtRTDC.Cells(intRTDC_RowBegin, 1), shtRTDC.Cells(intRTDC_RowLast, intRTDC_ColIdxTotal))
rngRTDC_AllDetail.AutoFilter
rngRTDC_AllDetail.AutoFilter Field:=intRTDC_ColIdxAcc, Criteria1:=rngCurrRow.Cells(1, intDTSource_ColIdxAccCode), Operator:=xlAnd
rngRTDC_AllDetail.AutoFilter Field:=intRTDC_ColIdxText, Criteria1:=rngCurrRow.Cells(1, strCurrAccCodeText), Operator:=xlAnd
Dim rngResult As Range
Set rngResult = rngRTDC_AllDetail.rows.SpecialCells(xlCellTypeVisible)'rngRTDC_AllDetail.SpecialCells(xlCellTypeVisible) also not work
'after filter, it will be only 1 result or none
If (rngResult.Rows.Count > 0) Then
'if the filter have result, do something here.
else
'add new row
End If
Next
My problem is after the filter, from the excelworksheet, i can see that have only 1 record, but
rngResult.Rows.Count = 2 'for the first filter record (that have 1 row only) in rngRTDC_AllDetail, i suspect due to it include the header, but i am not sure what wrong.
rngResult.Rows.Count = 1 'for the rest of the filter record that have 1 row
even worse is when there is no record after the filter, rngResult.Rows.Count = 1
Any advice will be appreciate. TQ.
Ok. After spent some time on it, I found out the solution already.
Below is some note for who facing similar problem.
Objective:
To insert "value" to columnC, when
columnA = "a" AND columnB ="b" AND the row is between 1 to 10 only
A B C
1 columnA | columnB | ColumnC
2 a | b | value
3 a | x |
4 x | x |
5 x | x |
6 c | b |
7 a | b | value
8 x | x |
9 x | x |
10 a | b | value
11 a | b |
12 a | b |
...
'insert value at columnC
ActiveSheet.Range("A1:B10").AutoFilter Field:=1, Criteria1:="a", Operator:=xlAnd
ActiveSheet.Range("A1:B10").AutoFilter Field:=2, Criteria1:="b", Operator:=xlAnd
Dim rng As Range
For Each rng In ActiveSheet.AutoFilter.Range.Range("A1:B10").SpecialCells(xlCellTypeVisible).Rows
If (rng.Row <> 1) Then 'no the header
ActiveSheet.Cells(rng.Row, "c") = "value" 'set value at C2,C7,C10
End If
Next rng
'count the total row visible
Dim rngA As Range
Set rngA = ActiveSheet.AutoFilter.Range.Range("A1:B10")
Debug.Print rngA.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1 'result 3
'Reference:http://www.contextures.com/xlautofilter03.html
Note1**: "ActiveSheet.AutoFilter.Range" will always include the header and all below row as visible row.
Note2**: "ActiveSheet.AutoFilter.Range.Offset(1, 0).SpecialCells(xlCellTypeVisible).Rows" will offset the range 1 row below only, not suitable if you need to set the value at the result row.