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)
Related
I want to create a function MyRange as follows:
Input: three numbers a,b,d
Output: an array of values from a to b with step size of d.
For example, if A1 contains 1, and B1 contains 5, and you write =MyRange(A1,B1,1) in the cell C1 (and you type Ctrl+Shift+Enter) you get:
A | B | C | D | E | F | G
-------------------------
1 | 5 | 1 | 2 | 3 | 4 | 5
Here's my trial:
Function MyRange(a, b, d)
Dim Index As Integer, Number As Integer
Dim Res() As Integer
Index = 0
For Number = a To b Step d
Res(Index) = Number
Index = Index + 1
Next Number
MyRange = Res
End Function
When I try this, Excel throws #VALUE! and I don't know what's the problem..
BTW yeah, I had a similar question before that got no answer, as it was too complicated, so I'd deleted it and simplified my question here.
This bit of cleanup worked for me. Mainly, I adding the ReDim Preserve to keep adding dimensions to the array.
Function MyRange(a As Integer, b As Integer, d As Integer) As Integer()
Dim Index As Integer, Number As Integer
Dim Res() As Integer
Index = 0
For Number = a To b Step d
ReDim Preserve Res(Index)
Res(Index) = Number
Index = Index + 1
Next Number
MyRange = Res
End Function
The problem you will have is with how many columns to select over from C to enter your formula. This will depend on d/b.
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.
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.
I'm traiting an 40M Excel file, I'm thinking of doing some deletes.
For example, I have the data in Sheet 1, and the primary key which I want to delete in sheet2.
Sheet 1
Column A | Column B | ...
0047 | a | ...
0048 | b | ...
0051 | c | ...
Sheet 2
Column A
0047
0051
Would you please tell me how do write a VBA script which delete line 0047 and 0051 in Sheet 1?
I'm new to VBA scripting.
try the code below. Loops through the rows until you find the values you are after using the line below you can delete rows:
Rows(i - j).Delete
Complete code:
Sub main()
Dim i As Integer
Dim j As Integer
j = 0
For i = 2 To 1000
If (Cells(i - j, 1) = "0047") Or (Cells(i - j, 1) = "0051") Then
Rows(i - j).Delete
j = j + 1
End If
Next i
End Sub