Selecting one column from each row in a table - vba

I have a table structured (Table Name: Table2) like below:
Using VBA, I want to select ONLY a single column value of the current row by iterating over each row.
Here is the code and I wrote:
Function findColumnValue(strColCombIdent As String, strColumnName As String) As String
On Error Resume Next
Dim strRetResult As String
Dim wsMapMasterRefSheet As Worksheet
'Referes to the table Table2.
Dim loMapMaster As ListObject
Set wsMapMasterRefSheet = ThisWorkbook.Worksheets("Sheet3")
Set loMapMaster = wsMapMasterRefSheet.ListObjects("Table2")
'All rows of the table Table2
Dim rAllRows As Range
Set rAllRows = loMapMaster.DataBodyRange
'Holds one row from the databody range for processing.
Dim rCurrRow As Range
'Process data
Dim strTemp As String
For Each rCurrRow In rAllRows
strTemp = rCurrRow.Columns(2)
Debug.Print strTemp
Next rCurrRow
findColumnValue = strRetResult
End Function
I was hoping to get results like below (ONLY the value of the column 2):
1.5
1.5
1.8
4
3
3
1
2
10
12
5
7
Instead I end up with something like this (All values from column#2 onwards, for each processing row.)
1.5
0.045150462962963
1.5
4.52083333333333E-02
1.8
4.72685185185185E-02
4
0.168090277777778
3
3.1
3
8.47800925925926E-02
1
4.16666666666667E-02
2
8.33449074074074E-02
10
10.1.1.1
12
1.3.4.5
5
0.212511574074074
7
8.54166666666667E-02
Using
strTemp = rCurrRow.Columns(1, 2)
instead of
strTemp = rCurrRow.Columns(2)
Causes runtime error 1004
Since each iteration points to a range object in the For loop; I was thinking using
rCurrRow.Columns(2)
will point to current Row's column#2 and hence print out only the column's value.
Is my logic misplaced?
One additional question:
Why does the MSDN Excel Reference guide describes Columns as a Property; where as clearly the "Columns" usage clearly takes parameters
Here is the link I referred:
http://msdn.microsoft.com/en-us/library/office/ff197454(v=office.15).aspx

Either specify you want to iterate rows:
For Each rCurrRow In rAllRows.Rows
or only look at the ListRows in the first place:
Function findColumnValue(strColCombIdent As String, strColumnName As String) As String
On Error Resume Next
Dim strRetResult As String
Dim wsMapMasterRefSheet As Worksheet
'Referes to the table Table2.
Dim loMapMaster As ListObject
Set wsMapMasterRefSheet = ThisWorkbook.Worksheets("Sheet3")
Set loMapMaster = wsMapMasterRefSheet.ListObjects("Table2")
'All rows of the table Table2
Dim rAllRows As ListRows
Set rAllRows = loMapMaster.ListRows
'Holds one row from the databody range for processing.
Dim rCurrRow As ListRow
'Process data
Dim strTemp As String
For Each rCurrRow In rAllRows
strTemp = rCurrRow.Range(, 2)
Debug.Print strTemp
Next rCurrRow
findColumnValue = strRetResult
End Function

You can call your variable rCurrRow all you want; VBA still won't know that you mean for it to contain an entire row of range rAllRows. It just assumes that rCurrRow represents one cell, such that For Each rCurrRow In rAllRows means "for each individual cell in this range".
What you need to do is limit the range being looped through. This should work; not tested.
For Each rCurrRow In rAllRows.Columns(2)
strTemp = rCurrRow
Debug.Print strTemp
Next rCurrRow
In fact I wouldn't call that variable rCurrRow at all; if you're going to use it in this way, call it e.g. cell instead.
EDIT: now that you have clarified your question in a comment below, you could do this:
For i = 1 To rAllRows.Rows.Count
Set rCurrRow = rAllRows.Rows(i)
strTemp = rCurrRow.Cells(1,2)
Debug.Print strTemp
Next i
But even better and faster would be to load the entire range to a two-dimensional Variant array at once, and loop over that array — much faster than looping over many cells.
Dim v As Variant
v = rAllRows ' load entire range to a 2D array
For i = 1 To UBound(v,1)
strTemp = v(i,2)
Debug.Print strTemp
Next i
Why does the MSDN Excel Reference guide describes Columns as a Property; where as clearly the "Columns" usage clearly takes parameters
Both methods and properties can take parameters. The distinction is more or less as follows:
Properties are things that you can get (like a range's Address, which takes no parameter, or subrange such as Column or Row or Cells, which do) and/or set (like a range's .Interior.Color, or .Hidden status). They are usually nouns.
Methods are things that do something to/with the range, and as such are usually verbs. Like .Select (takes no parameters) or .Copy (takes one parameter) or even .Speak.

Related

Efficient Data Transfer from Excel VBA to Web-Service

I have a large worksheet (~250K rows, 22 columns, ~40MB plain data) which has to transfer its content to an intranet API. Format does not matter. The problem is: When accessing the data like
Const ROWS = 250000
Const COLS = 22
Dim x As Long, y As Long
Dim myRange As Variant
Dim dummyString As String
Dim sb As New cStringBuilder
myRange = Range(Cells(1, 1), Cells(ROWS, COLS)).Value2
For x = 1 To ROWS
For y = 1 To COLS
dummyString = myRange(x, y) 'Runtime with only this line: 1.8s
sb.Append dummyString 'Runtime with this additional line 163s
Next
Next
I get a wonderful 2D array, but I am not able to collect the data efficiently for HTTP export.
An X/Y loop over the array and access myRange[x, y] has runtimes >1min. I was not able to find an array method which helps to get the imploded/encoded content of the 2D array.
My current workaround is missusing the clipboard (Workaround for Memory Leak when using large string) which works fast, but is a dirty workaround in my eyes AND has one major problem: The values I get are formatted, “.Value” and not “.Value2”, so I have to convert the data on server site again before usage, e.g. unformat currency cells to floats.
What could be another idea to deal with the data array?
My thoughts are that you create two string arrays A and B. A can be of size 1 to ROWS, B can be of size of 1 to COLUMNS. As you loop over each row in your myRange array, fill each element in B with each column's value in that row. After the final column for that row and before you move to the next row, join array B and assign to the row in A. With a loop of this size, only put necessary stuff inside the loop itself. At the end you would join A. You might need to use cstr() when assigning items to B.
Matschek (OP) was able to write the code based on the above, but for anyone else's benefit, the code itself might be something like:
Option Explicit
Private Sub concatenateArrayValues()
Const TOTAL_ROWS As Long = 250000
Const TOTAL_COLUMNS As Long = 22
Dim inputValues As Variant
inputValues = ThisWorkbook.Worksheets("Sheet1").Range("A1").Resize(TOTAL_ROWS, TOTAL_COLUMNS).Value2
' These are static string arrays, as OP's use case involved constants.
Dim outputArray(1 To TOTAL_ROWS) As String ' <- in other words, array A
Dim interimArray(1 To TOTAL_COLUMNS) As String ' <- in other words, array B
Dim rowIndex As Long
Dim columnIndex As Long
' We use constants below when specifying the loop's limits instead of Lbound() and Ubound()
' as OP's use case involved constants.
' If we were using dynamic arrays, we could call Ubound(inputValues,2) once outside of the loop
' And assign the result to a Long type variable
' To avoid calling Ubound() 250k times within the loop itself.
For rowIndex = 1 To TOTAL_ROWS
For columnIndex = 1 To TOTAL_COLUMNS
interimArray(columnIndex) = inputValues(rowIndex, columnIndex)
Next columnIndex
outputArray(rowIndex) = VBA.Strings.Join(interimArray, ",")
Next rowIndex
Dim concatenatedOutput As String
concatenatedOutput = VBA.Strings.Join(outputArray, vbNewLine)
Debug.Print concatenatedOutput
' My current machine isn't particularly great
' but the code above ran and concatenated values in range A1:V250000
' (with each cell containing a random 3-character string) in under 4 seconds.
End Sub

Looping through columns to get column numbers based on headers

I have a template with a set number of columns (170) and title headers (row 1 cell name's). This is always the same, until users add columns in between (they're instructed not to change headers). The idea is to make it tamperproof as far as the adding of columns is involved.
I'd like to make variables to hold some of the headers (with the capacity to hold all) and check these with the template to find out the column number (in a loop I reckon). It's probably wisest to make a function to call upon it?
Dim ColHeader1Str as string 'literal row 1, column 1 value (which is always
'the same string and position in the template)
Dim iColHeader1 as integer 'holds the (to be set) value of the column number
Set ColHeader1Str = "ColHeader1"
Now I'd like a loop where it loops trough all the columns (last column = 200) and checks to see what the column number is that matches the ColHeader1Str and store this in the iColHeader1
So something like:
Function find_columnNmbr
Dim i As Integer
For i = 1 To 200 Step 1
If 'ColHeader1Str matches actual column header name
'set found integer as iColHeader1 and so forth
Exit For
End If
Next
End Function`
I know I'm missing a few steps and I'm hoping you guys can help me out.
Update: The template has set column headers. When users interact with it a result could be that columns shift position, or they add more. I have a workbook that needs to load data out of the user's altered template.
I.E. The template has columns 1, 2, 3, 4 and the names are column1, column 2 etc. A user ads a random column so now there are 5. The loop needs to loop through the names of the column headers and identify the column number of the original template columns 1, 2 etc based on a string variable with the original names, which I've hard coded beforehand. These are public constants.
What function LookForHeaders do: input a string, then search for the string in usersheet.range(1:1). If it is found, return the column number of that cell, otherwise it returns 0.
Private Function LookForHeaders(ByVal headerName As String) As Long
Dim rng As Range
Dim userSheet As WorkSheet
Set userSheet = 'userSheet here'
On Error GoTo NotFound
LookForHeaders = userSheet.Range("1:1").Find(headerName).Column
Exit Function
NotFound:
LookForHeaders = 0
End Function
Private Sub Test()
Dim rng As Range
Dim template As WorkSheet
Set template = 'template here'
For Each rng In template.Range(Cells(1,1), Cells(1,200))
iColHeader1 = LookForHeaders(rng.Value)
'Do something with iColHeader1
Next rng
End Sub
Not sure what your looking for but here is example
Option Explicit
Public Sub Example()
Dim LastCol As Long
Dim i As Long
LastCol = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column
For i = 1 To LastCol
If Cells(i) = "Name" Then
Debug.Print Cells(i).Address
End If
Next
End Sub

Convert excel named Range to a collection of rows

I currently have a method which takes in a dynamic named range in excel and converts it to a 2D array.
I need to do some iterations to the data and carry out a Delete function if a certain column contains a value. I have looked at the options out there for deleting rows in 2d array using transpose and temp array and since my data is fairly large I am looking at other data structures that would make it easier to delete entire rows.
I want to convert a dynamic named range into a collection in vba. This collection will have a key the row number and as item should have all the data for that row. Basically I would need the ability to iterate through each value in that range like I can do with a 2D array but also the ability to delete a row efficiently and with less hassle than using a 2D array.
Anybody have an idea on how I can achieve this?
Dim srcArray () As Variant
Dim srcRange As Range
srcRange = ThisWorkbook.Worksheets("Main").Range("myNamedRange")
srcArray = srcRange.Value
Dim rowNr As Long
dim colNr As Long
for rowNr = 1 to UBound(srcArray,1)
if srcArray(rowNr, 9) = "testString" Then Call DeleteRowSub(srcArray, rowNr)
Next rowNr
DeleteRowSub will be a sub which will delete a given row based on the index of that row. I want to get away from that and just be able to say something like srcCollection.Remove(index) with index being the row nr.
Any help, greatly appreciated.
There's no secret to this. It's just housekeeping.
Function ReadRangeRowsToCollection(r As Range) As Collection
Dim iRow As Long
Dim iCol As Long
Dim rangeArr As Variant
Dim rowArr As Variant
Dim c As Collection
'Read range content to Variant array
rangeArr = r.Value
'Now transfer shit to collection
Set c = New Collection
For iRow = 1 To r.Rows.Count
ReDim rowArr(1 To r.Columns.Count)
For iCol = 1 To r.Columns.Count
rowArr(iCol) = rangeArr(iRow, iCol)
Next iCol
c.Add rowArr, CStr(iRow)
Next iRow
Set ReadRangeRowsToCollection = c
End Function
Example usage:
Dim c As Collection
Set c = ReadRangeRowsToCollection(Range("myNamedRange"))
c.Remove 1 ' remove first row from collection
Note: I haven't looked at edge cases; for example this will fail if the range is one cell only. Up to you to fix it.

VBA iterate through variant which has 2 columns

Was searching for a while, but cannot find a proper answer. I working on a variant and I used a solution provided below:
http://www.mrexcel.com/forum/excel-questions/305870-eliminate-duplicated-visual-basic-applications-array.html
So what I have is basically a variant which then beeing redimed without duplicates. It works fine if you use just one column from sheet so the variant variable has only 1 column as well.
The data I'm working on needs to be checked for 2 columns, while in the for each loop I would like to refer only to 2nd column:
Dim mgNames As Variant
Range(Cells(1, "I"), Cells(Range("a1").End(xlDown).Row, "J")).Select
mgNames = Selection
Dim myCollection As New Collection
Dim temp As Variant
On Error Resume Next
For Each temp In mgNames
myCollection.Add Item:=temp, Key:=temp
Next temp
On Error GoTo 0
ReDim mgNames(1 To myCollection.Count)
For temp = 1 To myCollection.Count
mgNames(temp) = myCollection(temp)
Next temp
so in part For Each temp In mgNames code takes each value in variant, ex mgnames(1,1) then mgnames(1,2) and so on. I would like to iterate this only for 2nd column, so from (1,2) (2,2), (3,2)...
If anyone is able to help with this it would be great
You don't have to loop through the array with For Each, you can use a normal For, as in
Dim i As Long
...
For i = LBound(mgNames,1) To Ubound(mgNames,1)
myCollection.Add Item:=mgNames(i,2), Key:=mgNames(i,2)
Next i
...

pulling out data from a colums in Excel

I have the following Data in Excel.
CHM0123456 SRM0123:01
CHM0123456 SRM0123:02
CHM0123456 SRM0256:12
CHM0123456 SRM0123:03
CHM0123457 SRM0789:01
CHM0123457 SRM0789:02
CHM0123457 SRM0789:03
CHM0123457 SRM0789:04
What I need to do is pull out all the relevent SRM numbers that relate to a single CHM ref. now I have a formular that will do some thing like this
=INDEX($C$2:$C$6, SMALL(IF($B$8=$B$2:$B$6, ROW($B$2:$B$6)-MIN(ROW($B$2:$B$6))+1, ""), ROW(A1)))
however this is a bit untidy and I really want to produce this same using short vb script, do i jsut have to right a loop that will run though and check each row in turn.
For x = 1 to 6555
if Ax = Chm123456
string = string + Bx
else
next
which should give me a final string of
SRM0123:01,SRM123:02,SRM0256:12,SRM0123:03
to use with how i want.
Or is ther a neater way to do this ?
Cheers
Aaron
my current code
For x = 2 To 6555
If Cells(x, 1).Value = "CHM0123456" Then
outstring = outstring + vbCr + Cells(x, 2).Value
End If
Next
MsgBox (outstring)
End Function
I'm not sure what your definition of 'neat' is, but here is a VBA function that I consider very neat and also flexible and it's lightning fast (10k+ entires with no lag). You pass it the CHM you want to look for, then the range to look in. You can pass a third optional paramater to set how each entry is seperated. So in your case you could write (assuming your list is :
=ListUnique(B2, B2:B6555)
You can also use Char(10) as the third parameter to seperat by line breaks, etc.
Function ListUnique(ByVal search_text As String, _
ByVal cell_range As range, _
Optional seperator As String = ", ") As String
Application.ScreenUpdating = False
Dim result As String
Dim i as Long
Dim cell As range
Dim keys As Variant
Dim dict As Object
Set dict = CreateObject("scripting.dictionary")
On Error Resume Next
For Each cell In cell_range
If cell.Value = search_text Then
dict.Add cell.Offset(, 1).Value, 1
End If
Next
keys = dict.keys
For i = 0 To UBound(keys)
result = result & (seperator & keys(i))
Next
If Len(result) <> 0 Then
result = Right$(result, (Len(result) - Len(seperator)))
End If
ListUnique = result
Application.ScreenUpdating = True
End Function
How it works: It simple loops through your range looking for the search_string you give it. If it finds it, it adds it to a dictionary object (which will eliminate all dupes). You dump the results in an array then create a string out of them. Technically you can just pass it "B:B" as the search array if you aren't sure where the end of the column is and this function will still work just fine (1/5th of a second for scanning every cell in column B with 1000 unique hits returned).
Another solution would be to do an advancedfilter for Chm123456 and then you could copy those to another range. If you get them in a string array you can use the built-in excel function Join(saString, ",") (only works with string arrays).
Not actual code for you but it points you in a possible direction that can be helpful.
OK, this might be pretty fast for a ton of data. Grabbing the data for each cell takes a ton of time, it is better to grab it all at once. The the unique to paste and then grab the data using
vData=rUnique
where vData is a variant and rUnique is the is the copied cells. This might actually be faster than grabbing each data point point by point (excel internally can copy and paste extremely fast). Another option would be to grab the unique data without having the copy and past happen, here's how:
dim i as long
dim runique as range, reach as range
dim sData as string
dim vdata as variant
set runique=advancedfilter(...) 'Filter in place
set runique=runique.specialcells(xlCellTypeVisible)
for each reach in runique.areas
vdata=reach
for i=lbound(vdata) to ubound(vdata)
sdata=sdata & vdata(i,1)
next l
next reach
Personally, I would prefer the internal copy paste then you could go through each sheet and then grab the data at the very end (this would be pretty fast, faster than looping through each cell). So going through each sheet.
dim wks as worksheet
for each wks in Activeworkbook.Worksheets
if wks.name <> "CopiedToWorksheet" then
advancedfilter(...) 'Copy to bottom of list, so you'll need code for that
end if
next wks
vdata=activeworkbook.sheets("CopiedToWorksheet").usedrange
sData=vdata(1,1)
for i=lbound(vdata) + 1 to ubound(vdata)
sData=sData & ","
next i
The above code should be blazing fast. I don't think you can use Join on a variant, but you could always attempt it, that would make it even faster. You could also try application.worksheetfunctions.contat (or whatever the contatenate function is) to combine the results and then just grab the final result.
On Error Resume Next
wks.ShowAllData
On Error GoTo 0
wks.UsedRange.Rows.Hidden = False
wks.UsedRange.Columns.Hidden = False
rFilterLocation.ClearContents