Probably a newbie question, but is there a good way to bring together / concatenate values from a range of cells and set that as a string?
It's not a small data set, each cell has two characters and the range is usually around A1:YA1, something like 650 cells.
I'm not sure if I'm saying anything correctly, but let's say each cell A1:CU1 had a value that counted from 01 to 99. I'd like to do something like this
Sub Sample()
Dim cell_values As String
cell_values = A1:CU1
and get a string that would output
0102030405060708091011121314...99
Thanks!
Here's something to get you started:
Public Sub foo()
Dim cell_values() As Variant
cell_values = Sheet1.Range("A1:G1")
Dim result As String
Dim r As Long, c As Long
For r = 1 To UBound(cell_values, 1)
For c = 1 To UBound(cell_values, 2)
result = result + cell_values(r, c)
Next
Next
Debug.Print result
End Sub
Or just
X = Join(Application.Transpose(Application.Transpose(Range("A1:CU1"))), vbNullString)
Related
I have two arrays: TempSubject(), which carries a list of subjects, and friRoutine(), which indicates when subjects are taught.
I need to enforce a rule that no particular subject can not be taught twice on a specific day. I have a function named DetectDuplicate(friRoutine, Tempsubject(i)), which checks friRoutine() with TempSubject() and finds whether friRoutine already contains a particular subject. If No, then add that unique subject to friRoutine. Otherwise continue through the loop for next subject. My code is furnished below as follows-
Dim TempSubject() As String = {"Maths","English","Sanskrit","Sanskrit","Urdu","Urdu","Urdu","French","French","French","Physical Education","Physical Education","Game","Game", "Science"}
dim c4 as integer = 0
dim limitcounter = 0
dim friRoutine() as string
reedim friRoutine(6)
While c4 < TempSubject.Length
If DetectDuplicate(friRoutine, TempSubject(c4)) = False And limitcounter4 < 7 Then
friRoutine(limitcounter4) = TempSubject(c4)
'MessageBox.Show(c1 & ": " & limitcounter1 & ": " & tueRoutine(limitcounter1))
Debug.WriteLine("Friday: " & c4 & ": " & limitcounter4 & ": " & friRoutine(limitcounter4))
TempSubject.RemoveAt(c4)
limitcounter4 = limitcounter4 + 1
End If
c4 = c4 + 1
End While
Private Function DetectDuplicate(ByVal arr As Array, ByVal str As String) As Boolean
Dim numcount As Integer = 0
For numcount = 0 To arr.Length - 1
If arr(numcount) = str Then
Return True
End If
Next
Return False
End Function
The Output is supposed to be
friRoutine = Math, english, sanskrit, Urdu, French, Physical education, game
but unfortunately, English is missing.
the output is:
friRoutine = Math, sanskrit, Urdu, French, Physical education, game, science
I'm afraid of using my code as it may spoil the entire process at any point of time.
I think the problem is with Function DetectDuplicate()
Edit (From a comment)
I have to remove the used elements. My original program will have 42 subjects and 6 days. 7 periods everyday. For example if i picked up 7 unique subjects for Monday then for the next 6 days i must have only 35 subjects to be adjusted for rest of the 5 days.
The first thing I would do is convert the arrays to generic Lists. So this:
Dim TempSubject() As String = {"Maths","English","Sanskrit","Sanskrit","Urdu","Urdu","Urdu","French","French","French","Physical Education","Physical Education","Game","Game", "Science"}
Dim friRoutine() As String
Becomes this:
Dim TempSubject As New List(Of String) From {"Maths","English","Sanskrit","Sanskrit","Urdu","Urdu","Urdu","French","French","French","Physical Education","Physical Education","Game","Game", "Science"}
Dim friRoutine As New List(Of String)(6)
You can access items in these lists by index, just like with arrays, but now it becomes MUCH easier to do things like add or remove entries. At least, I would do this for the friRoutine collection; there is some argument to made for an array in way TempSubject is used in this code, but even there the data likely came form somewhere that would justify a List(Of String) instead.
That done, you can greatly simplify the code:
friRoutine.AddRange(TempSubject)
friRoutine = friRoutine.Distinct().Take(7).ToList()
Or, to show the entire sample:
Dim TempSubject = {"Maths","English","Sanskrit","Sanskrit","Urdu","Urdu","Urdu","French","French","French","Physical Education","Physical Education","Game","Game", "Science"}
Dim friRoutine As New List(Of String)(TempSubject.Distinct().Take(7))
For i As Integer = 0 to friRoutine.Count - 1
Debug.WriteLine($"Friday: {i} : {friRoutine(i)}")
Next
And now that we see the data for friRoutine can be computed from a single line of code, one wonders if we really need the separate collection at all.
As for the original code, the big problem was this line:
TempSubject.RemoveAt(c4)
This modified the collection while still looping through it. Everything would shift forward, causing some items to be skipped.
Just use Enumerable.Distinct<T>()
Dim TempSubject = {"Maths","English","Sanskrit","Sanskrit","Urdu","Urdu","Urdu","French","French","French","Physical Education","Physical Education","Game","Game", "Science"}
Dim friRoutine = TempSubject.Distinct().ToArray()
If you want a List output instead, then it's simply
Dim friRoutine = TempSubject.Distinct().ToList()
Since both array and List are Enumerable, TempSubject can be either an array or List.
My Goal is to take two rows(FirstName and Surname) Convert them to a single Array of "FirstName, Surname".
This is my terrible code i eventually put together
Private Sub Search_Load(sender As Object, e As EventArgs) Handles MyBase.Load
'TODO: This line of code loads data into the 'DbaPatientDataSet.tblPatientData' table. You can move, or remove it, as needed.
Me.TblPatientDataTableAdapter.Fill(Me.DbaPatientDataSet.tblPatientData)
listFirst.DataSource = Me.TblPatientDataBindingSource
listFirst.DisplayMember = "FirstName"
listLast.DataSource = Me.TblPatientDataBindingSource
listLast.DisplayMember = "Surname"
Dim Lenth As Integer = Me.listFirst.Items.Count - 1
Dim count As Integer = 1
Dim ArrFirst(Lenth) As String
Dim ArrLast(Lenth) As String
For count = 1 To Lenth
ArrFirst(count) = listFirst.Items(count).ToString
ArrLast(count) = listLast.Items(count).ToString
Next count
count = 1
For count = 1 To Lenth
arrFullName(count) = ArrLast(count) & ", " & ArrFirst(count)
Next count
'Arrays Set =====================================================
But with this code i get an Array of
`"Sytem.Data.DataRowView, Sytem.Data.DataRowView"
"Sytem.Data.DataRowView, Sytem.Data.DataRowView"
"Sytem.Data.DataRowView, Sytem.Data.DataRowView"
"Sytem.Data.DataRowView, Sytem.Data.DataRowView"
`
As you can see
Here
There must be an easy way to convert both DataRows to strings then concatenate them together in an array
I am going to search this array using a Binary Search to find a desired name
Thanks
First, I think you are confusing your rows and your columns. You have 2 columns. I went directly to full name but I think you can break it out if you need to.
Dim arrNames(ListBox1.Items.Count - 1) As String
For i As Integer = 0 To ListBox1.Items.Count - 1
arrNames(i) = $"{ListBox1.Items(i)} {ListBox2.Items(i)}"
Next
For Each item In arrNames
Debug.Print(item)
Next
The string with the $ in front is an interpolated string. Sort of an improvement to String.Format.
I know there is an answer but for now you could go direct to the data table to get what you need.
Dim arrNames(ListBox1.Items.Count - 1) As String
Dim i As Integer = 0
Dim dt As DataTable = DbaPatientDataSet.Tables(0)
For Each row As DataRow In dt.Rows
arrNames(i) = $"{row("Surname")}, {row("FirstName")}"
i += 1
Next
For Each item In arrNames
Debug.Print(item)
Next
'assume the names of your columns are Surname and FirstName
If I run your code up, I get the result you are looking for, so I'm not sure what you are missing. In saying that though, you are making things hard on yourself by messing around with arrays :). Just use the dataset rows directly - they are strongly typed and you can check for nulls etc as needed... something like this;
Dim fullNames As New List(Of String) '-- or you could fill your array.
For Each row As DbaPatientDataSet.tblPatientDataRow In ds.tblPatientData
fullNames.Add(row.Surname & ", " & row.FirstName)
Next
Just looking at what you are trying to achieve, if it was me, I would be bringing back the formatted data in my query that fills the dataset i.e. a third, FullName, column.
It has been in the back of my mind. Finally got it for the List Box directly.
Dim arrFullNames(ListBox1.Items.Count - 1) As String
Dim i As Integer = 0
For Each item As DataRowView In ListBox1.Items
arrFullNames(i) = $"{DirectCast(item("Surname"), String)}, {DirectCast(item("Firstname"), String)}"
i += 1
Next
For Each item As String In arrFullNames
Debug.Print(item)
Next
I'm very new to VBA, to bear with me here.
I want to assign a set of variables the value of a set of ranges ie. run a brief code to simplify the following
Dim Sample 1 as string
Sample1 = activeworksheet.range("C17").value
Dim Sample 2 as string
Sample2 = activeworksheet.range("C18").value}
and so on
Following an excelfunctions.net tutorial, I know that I can shorten the declaration to
Dim Sample(1 to 20) as a string
But the tutorial drops it there(because it's a tutorial about names), suggesting I populate it as follows
sample(1)=activesheet.range("C7").value
sample(2)=activesheet.range("C7").value
and so on
I found the discussion below to be on the right track to answer my quest, but I am having trouble applying it to my situation. (Excel VBA Array Ranges for a loop)
As a follow up note, I am ultimately trying to assign values to these variables for use in the following procedures, rather than declaring and assigning them each time.
Thanks!
Try something like this:
Sub test()
Dim sampleArr(1 To 20) As String
Dim i As Integer
Dim rng As Range, cel As Range
i = 1
Set rng = Range("C1:C20")
For Each cel In rng
sampleArr(i) = cel.Value
i = i + 1
Next cel
For i = LBound(sampleArr) To UBound(sampleArr)
Debug.Print sampleArr(i)
Next i
Also, if you know the range you want to put into an array, you can simply set an array to that range:
Sub test()
Dim sampleArr() As Variant
Dim i As Integer
Dim rng As Range, cel As Range
i = 1
Set rng = Range("C1:C20") ' Note, this creates a 2 Dimensional array
sampleArr = rng ' Right here, this sets the values in the range to this array.
For i = LBound(sampleArr) To UBound(sampleArr)
Debug.Print sampleArr(i, 1) ' you need the ",1" since this is 2D.
Next i
End Sub
You should :
Define the range you want to retrieve data
For each cell of the range, retrieve your datas
dim tab() As string, cell as range, i as integer
i = 0
redim tab(0)
for each cell in ActiveWorksheet.Range("C1:C20")
tab(i) = cell
i = i + 1
redim preserve tab(i)
next
edit : I indent the code to display it correctly
Additional way to the above you can only use:
Arr = ActiveWorksheet.Range("C1:C20").Value
Then you can directly use:
Arr(i,1) where i is C1 to C20 range!
I've read the post on this VBA problem, but my VBA script is still not working.
Public Sub Test()
Dim arrNames As Variant 'Declare array named "arrNames"
arrNames = Sheet1.Range("F2:F1000") 'Array filled with column F
intN = Application.CountIf(arrNames, "*") 'does not work intent: count cells w/info
'intN = Application.CountA(arrNames) 'works but MsgBox displays value of 999
MsgBox (intN)
End Sub
How do I get the number of cells in my array containing any value?
EDITED version after help
Public Sub Test()
Dim arrNames As Variant 'Declare array named "arrNames"
Dim i As Long
arrNames = Sheet1.Range("F2:F1000") 'Array filled with column F
For i = LBound(arrNames) To UBound(arrNames)
If (arrNames(i,1) = "") Then
EmptyCounter = EmptyCounter + 1
End If
Next i
End Sub
There is no direct way to do it, as far as I understand. But you could run a simple loop to check if the values are equal to "" assuming string data.
For e.g.
For i = LBound(ArrayName) to UBound(ArrayName)
If (ArrayName(i) = "") Then
EmptyCounter = EmptyCounter + 1
End If
Next i
If it's numeric or other type of data, you may try variations of the above loop using functions such as IsEmpty(VariableName) etc.
You can try this:
intN = Worksheets("Sheet1").Range("F2:F1000").Cells.SpecialCells(xlCellTypeConstants).Count
MsgBox intN
100% it works.
I am developing a macro to eliminate blank rows from a worksheet which is used for entering customized orders. Lets say rows 7,8,9 and 12 have contents. I want to move the contents of row 12 to row 10.
So far I've located the last occupied row in column c then identified whether the cell in the row in column e is blank or not.
Now I want to put a value into an array either 0 (blank) or 1 (occupied). I am getting an error (object required) on the line of code that sets the value of stones (1) to 1 or 0.
What is going wrong?
Dim ws As Worksheet
Dim rng1 As Range
Set ws = Sheets("Belmont")
Set rng1 = ws.Columns("c").Find("*", ws.[c1], xlValues, , xlByRows, xlPrevious)
Dim zen As String
zen = rng1.Address(0, 0)
Range(zen).Select
Set ruby = Window.ActiveCell.Row - 11
Dim stones() As Boolean
ReDim stones(1 To ruby)
If IsEmpty(ActiveCell.Offset(2, 0)) Then
Set stones(1) = 0
Else
Set stones(1) = 1
End If
msg55 = MsgBox(stones(1), vbDefaultButton1, "Gekko")
My assumption is that you are doing this for purposes of learning rather than practicality:
You could google VBA arrays and get a plethora of material on the subject. I would start here:
http://www.cpearson.com/excel/vbaarrays.htm
You would declare your array like so:
Dim stones(1 To 10) As Double
You're going to have to iterate through each cell in your range. You can Google how to do that as well:
Loop through each cell in a range of cells when given a Range object
You can set the value of the 5th element in the array to the value of 10 like so:
stones(5) = 10
It really seems like you need to do some basic VBA programming tutorials. You could start here:
http://www.mrexcel.com/forum/excel-questions/667818-tutorials-excel-macros-visual-basic-applications.html
If you're trying to get rid of blank cells in sheet 'Belmont' column C, then this should work for you:
Sub tgr()
Dim rngBlanks As Range
With Sheets("Belmont").Range("C1", Sheets("Belmont").Cells(Rows.Count, "C").End(xlUp))
On Error Resume Next
Set rngBlanks = .SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If Not rngBlanks Is Nothing Then rngBlanks.EntireRow.Delete
End With
Set rngBlanks = Nothing
End Sub
If you want to delete all rows in which column C is blank, then:
Sub dural()
Dim r As Range
Set r = Range("C:C").Cells.SpecialCells(xlCellTypeBlanks).EntireRow
r.Delete
End Sub
will accomplish this without looping.