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.
Related
Given two columns (A and B), one with a text and one with an integer, such as:
A | B
pen | 3
pen | 5
How could I fill the columns C, D, E [...] with the concatenation of the given string on each row with all integers starting from 1 until the specified number?
The desired output for the given example would be:
A | B | C | D | E | F | G
pen | 3 | pen01 | pen02 | pen03 | |
pen | 5 | pen01 | pen02 | pen03 | pen04 | pen05
With a simple vba sub this can be achieved:
Sub CreateValues
With ActiveSheet
Dim LastRow as Long: LastRow = .Range("A" & .Rows.Count).End(xlup).Row
For i = 1 To LastRow
Max_Num = .Cells(i, 2)
For j = 1 to Max_Num
.Cells(i, j + 2) = .Cells(i, 1) & Format(j, "00")
Next j
Next i
End With
End Sub
If you are looking for a formula solution without needing to resort to VBA, you can use this formula in C1 and drag in both dimensions:
=IF(COLUMNS($C1:C1)<=$B1,CONCATENATE($A1,TEXT(COLUMNS($C1:C1),"00")),"")
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'm trying to combine rows in a DataTable based on their shared ID. The table data looks something like this:
Member | ID | Assistant | Content
---------------------------------------------
16 | 1234 | jkaufman | 1/1/2015 - stuff1
16 | 1234 | jkaufman | 1/2/2015 - stuff2
16 | 4321 | mhatfield | 1/3/2015 - stuff3
16 | 4321 | mhatfield | 1/4/2015 - stuff4
16 | 4321 | mhatfield | 1/5/2015 - stuff5
16 | 5678 | psmith | 1/6/2015 - stuff6
I want to combine rows based on matching IDs. There are two steps I could use some clarification on. The first is merging the rows. The second is combining the Content columns so that the contents aren't lost. For the example above, here's what I want:
Member | ID | Assistant | Content
-------------------------------------------------------------------------------------------
16 | 1234 | jkaufman | 1/1/2015 - stuff1 \r\n 1/2/2015 - stuff2
16 | 4321 | mhatfield | 1/3/2015 - stuff3 \r\n 1/4/2015 - stuff4 \r\n 1/5/2015 - stuff5
16 | 5678 | psmith | 1/6/2015 - stuff6
My eventual goal is copy the DataTable to an Excel spreadsheet so I'm not sure sure if the \r\n is the correct newline character but that's the least of my concerns at this point.
Here's my code right now (EDIT: updated to current code):
Dim tmpRow As DataRow
dtFinal = dt.Clone()
Dim i As Integer = 0
While i < dt.Rows.Count
tmpRow = dtFinal.NewRow()
tmpRow.ItemArray = dt.Rows(i).ItemArray.Clone()
Dim j As Integer = i + 1
While j <= dt.Rows.Count
If j = dt.Rows.Count Then 'if we've iterated off the end of the datset
i = j
Exit While
End If
If dt.Rows(i).Item("ID") = dt.Rows(j).Item("ID") Then 'if we've found another entry for this id
'append change to tmpRow
tmpRow.Item("Content") = tmpRow.Item("Content").ToString & Environment.NewLine & dt.Rows(j).Item("Content").ToString
Else 'if we've run out of entries to combine
i = j
Exit While
End If
j += 1
End While
'add our combined row to the final result
dtFinal.ImportRow(tmpRow)
End While
When I export the final table to Excel, the spreadsheet is blank so I'm definitely doing something wrong.
Any help would be fantastic. Thanks!
I see various problems with your approach (with both versions; but the second one seems better). That's why I have preferred to write a whole working code to help transmit my ideas clearly.
Dim dtFinal As DataTable = New DataTable
For Each col As DataColumn In dt.Columns
dtFinal.Columns.Add(col.ColumnName, col.DataType)
Next
Dim oldRow As Integer = -1
Dim row As Integer = -1
While oldRow < dt.Rows.Count - 1
dtFinal.Rows.Add()
row = row + 1
oldRow = oldRow + 1
Dim curID As String = dt.Rows(oldRow)(1).ToString()
Dim lastCol As String = ""
While (oldRow < dt.Rows.Count AndAlso dt.Rows(oldRow)(1).ToString() = curID)
lastCol = lastCol & dt.Rows(oldRow)(3).ToString() & Environment.NewLine
oldRow = oldRow + 1
End While
oldRow = oldRow - 1
For i As Integer = 0 To 2
dtFinal.Rows(row)(i) = dt.Rows(oldRow)(i)
Next
dtFinal.Rows(row)(3) = lastCol
End While
Note that trying to come up with the most "elegant" solution or to maximise the given in-built functionalities might not be the best way to face certain situations. In the problem you propose, for example, I think that it is better going step by step (and reducing code size/improving elegance only after a properly working version is in place). This is the kind of code I have tried to create here: a simple one delivering what is expected (I think that this is the exact functionality you want; in any case, bear in mind that I am including a simplistic code which you are expected to take as a mere help to understand the point).
I find the VB syntax clunky compared to how it would be in C#, but you may prefer this Linq with grouping solution:
Dim merge = (From rw In dt.Rows.OfType(Of DataRow)()
Group rw By
New With {.fld1 = rw(0)}.fld1,
New With {.fld2 = rw(1)}.fld2,
New With {.fld3 = rw(2)}.fld3 Into Group).
Select(Function(x)
Return New With {.Member = x.fld1,
.ID = x.fld2,
.Assistant = x.fld3,
.Content = String.Join("", x.Group.Select(Function(y)
Return String.Join("", y.ItemArray)
End Function))}
End Function)
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 have an Excel 2007 table which looks like this:
/| A | B | C | D
-+---------+----------+----------+----------+
1| Item1 | Info a | 1200 | sum(C1:C2)
2| | | 2130 |
3| Item2 | Info b | 2100 | sum(C3:C7)
5| | | 11 |
6| | | 12121 |
7| | | 123 |
8| Item3 | Info c | 213 | sum(C8:C10)
9| | | 233 |
10| | | 111 |
What I hope to do is that whenever I select the entire table (A1:C10 for the above example) and press <Ctrl> + <M>, the macro code will automatically merge the blank cells with the cell above them that contains text e.g. A1 to A2; A3 to A7 and so forth. The same goes for column B. For column D, after merging, it would also sum up all the items in column C. I could do the merging and summation manually, however it would take me quite a while so I've been looking into macros to make life easier.
I would like to emphasize that the number of rows to merge on each item is variable (Item 1 has only 2 rows - A1 and A2, Item 2 has 4, and so on.)
Is this possible to do in Excel VBA? Any help and comments are greatly appreciated.
If you have a large number of rows, avoid looping through the cells themselves, as this is quite slow. Instaed copy the cells values to a Variant array first.
Option Explicit
Sub zx()
Dim rngTable As Range
Dim vSrcData As Variant
Dim vDestData As Variant
Dim i1 As Long, i2 As Long, i3 As Long, i4 As Long
Set rngTable = Range("A1:D10")
vSrcData = rngTable
' vSrcData is now a two dimensional array of Variants
' set vDestData to an array of the right size to contain results
ReDim vDestData(1 To WorksheetFunction.CountA(rngTable.Columns(1)), _
1 To UBound(vSrcData, 2))
' keep track of row in Destination Data to store next result
i3 = LBound(vSrcData, 1)
' loop through the Source data
For i1 = 1 To UBound(vSrcData, 1) - 1
' sum the rows with blanks in clumn A
If vSrcData(i1, 1) <> "" Then
For i2 = i1 + 1 To UBound(vSrcData, 1)
If vSrcData(i2, 1) = "" Then
vSrcData(i1, 3) = vSrcData(i1, 3) + vSrcData(i2, 3)
Else
Exit For
End If
Next
' copy the result to Destination array
For i4 = 1 To UBound(vSrcData, 2)
vDestData(i3, i4) = vSrcData(i1, i4)
Next
i3 = i3 + 1
End If
Next
' delete original data
rngTable.ClearContents
' Adjust range to the size of results array
Set rngTable = rngTable.Cells(1, 1).Resize(UBound(vDestData, 1), _
UBound(vDestData, 2))
' put results in sheet
rngTable = vDestData
End Sub
Set Quick Key from Excel, Tools/Macros menu, Options