Run-time error '9': Subscript out of range when accessing Sheets - vba
I have following function which returns me list of current sheets
Function getListOfSheetsW() As Variant
Dim i As Integer
Dim sheetNames() As Variant
ReDim sheetNames(1 To Sheets.Count)
For i = 1 To Sheets.Count
sheetNames(i) = Sheets(i).name
Next i
getListOfSheetsW = sheetNames
End Function
This function returns array starting at position 1. My goal was to create same function but starting with position 0, I've tried:
Function getListOfSheetsNW() As Variant
Dim i As Integer
Dim sheetNames() As Variant
ReDim sheetNames(Sheets.Count - 1)
For i = 0 To Sheets.Count
sheetNames(i) = Sheets(i + 1).name
Next i
getListOfSheetsNW = sheetNames
End Function
But this return me:
Run-time error '9': Subscript out of range
What is wrong with my code?
PS: I'm calling those functions following way:
Sub callGetListOfSheetsW()
Dim arr() As Variant
' arr = getListOfSheetsW()
arr = getListOfSheetsNW()
MsgBox arr(1)
MsgBox arr(2)
End Sub
The worksheet count will always be one based.
Function getListOfSheetsNW() As Variant
Dim i As Integer
Dim sheetNames() As Variant
ReDim sheetNames(Sheets.Count - 1)
For i = 0 To Sheets.Count - 1 '<~~This. Alternately as For i = 0 To UBound(sheetNames)
sheetNames(i) = Sheets(i + 1).name
Next i
getListOfSheetsNW = sheetNames
End Function
Related
excel , extract the time Break from one cell in excel sheet?
I have an Excel sheet like below and I need only the three "Break" times even if it meant to delete every thing except those three Breaks in every cell. Function GetBreaksTime(txt As String) Dim i As Long Dim arr As Variant arr = Split(txt, "Break") If UBound(arr) > 0 Then ReDim startTimes(1 To UBound(arr)) As String For i = 1 To UBound(arr) startTimes(i) = WorksheetFunction.Trim(Replace(Split(arr(i), "-")(0), vbLf, "")) Next GetBreaksTime = startTimes End If End Function This what I got until now but it wont work on every cell and it takes wrong values. So any idea how to do this?
If you split the cell value by vbLf the break time will always follow a line containing "Break".
The following should work:
Sub TestGetBreakTimes()
Dim CellValue As String
CellValue = Worksheets("Sheet1").Range("A1").Value
Dim BreakTimes As Variant
BreakTimes = GetBreakTimes(CellValue)
Debug.Print Join(BreakTimes, vbLf) 'the join is just to output the array at once.
'to output in different cells loop through the array
Dim i As Long
For i = 0 To UBound(BreakTimes)
Cells(3 + i, "A") = BreakTimes(i)
Next i
'or for a even faster output use
Range("A3").Resize(UBound(BreakTimes) + 1).Value = WorksheetFunction.Transpose(BreakTimes)
End Sub
Function GetBreakTimes(InputData As String) As Variant
Dim BreakTimes() As Variant
ReDim BreakTimes(0)
Dim SplitArr As Variant
SplitArr = Split(InputData, vbLf) 'split by line break
If UBound(SplitArr) > 0 Then
Dim i As Long
For i = 0 To UBound(SplitArr)
If SplitArr(i) = "Break" Then 'if line contains break then next line is the time of the break
If BreakTimes(0) <> vbNullString Then ReDim Preserve BreakTimes(UBound(BreakTimes) + 1)
BreakTimes(UBound(BreakTimes)) = SplitArr(i - 1) 'collect break time
End If
Next i
GetBreakTimes = BreakTimes
End If
End Function
To analyze a complete range you must loop through your row 2
Sub GetAllBreakTimes()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim LastCol As Long
LastCol = ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column
Dim BreakTimes As Variant
Dim iCol As Long
For iCol = 1 To LastCol
BreakTimes = GetBreakTimes(ws.Cells(2, iCol).Value)
ws.Cells(3, iCol).Resize(UBound(BreakTimes) + 1).Value = WorksheetFunction.Transpose(BreakTimes)
Next iCol
End Sub
VBA to extract names from a list at random isn't working
I want to randomly extract 280 names from a list (dynamic range) of thousands of authors, then concatenate them into 1 string with each name separated by OR.
So far I'm stuck at the first part. When I run the following code, nothing happens. Can anyone explain why? Thanks.
Sub Authors()
Dim InputRange As Range
Dim AuthorCount As Long
Dim AuthorRange As Excel.Range
Set InputRange = Range("A:A")
AuthorCount = Application.WorksheetFunction.CountA(InputRange) - 1
Set AuthorRange = ThisWorkbook.Worksheets("Sheet").Range("A2:A" & AuthorCount)
Const nItemsToPick As Long = 280
Dim Authorlist As Variant
Dim i As Long
ReDim Authorlist(1 To nItemsToPick)
For i = 1 To nItemsToPick
Authorlist(i) = AuthorRange.Cells(Int(AuthorCount * Rnd + 1), 1)
Next i
End Sub
Using the below code Sub PickSample(intSampleSize As Integer, intPicks As Integer) Dim arr() As String Dim intCounter As Integer ReDim arr(intPicks) For intCounter = 0 To UBound(arr) arr(intCounter) = CStr(Int((intSampleSize - (i - 1)) * Rnd + 1) + (i - 1)) Next intCounter Debug.Print Join(arr(), ",") End Sub I ran this on the following, PickSample(10,5) and got the following, showing the duplicate possibilities, this will become less as the difference between picks and samples increases. 9,9,6,10,10,2 5,3,6,7,2,3 10,4,5,8,0,6 9,8,4,10,9,0 0,8,8,7,0,4 7,5,6,3,3,8 If your selection is 280, but the data set is only 300, dupes still arise PickSample 300,280 228,**92**,248,216,269,66,**107**,166,**107**,61,174,189,41,18,190,252,192,127,56,149,292,231,114,145,164,202,11,194,270,102,35,128,232,**107**,124,225,131,216,152,52,83,26,294,85,186,**92**,256,96,239,52,90,21,148,136,179,9,95,40,98,228,188,290,249,166,182,57,271,95,180,179,230,215,206,228,77,165,153,170,84,125,105,292,156,175,139,9,113,41,196,46,59,112,28,185,211,132,126,101,210,64,13,266,13,138,222,227,247,63,141,261,249,123,139,105,75,242,163,162,188,26,214,77,17,82,289,98,194,109,111,98,64,63,127,185,72,206,177,181,23,13,46,74,120,175,86,251,270,158,116,0,75,49,194,295,93,72,264,39,171,182,183,208,255,29,118,247,80,204,119,251,130,251,65,220,270,65,295,290,262,157,195,137,47,193,184,257,110,15,152,16,112,135,89,291,3,195,184,160,8,215,94,295,87,109,96,106,70,178,211,80,173,173,298,280,75,243,231,122,189,148,150,40,291,53,177,205,32,195,222,234,129,24,150,172,17,124,35,43,94,298,181,82,125,141,19,137,131,284,82,52,152,103,154,119,78,20,192,109,164,265,127,178,114,17,32,43,43,228,79,41,12,208,254,155,240,296,157,20,188,99,83 4,50,49,153,122,31,83,193,255,149,56,269,112,97,232,65,134,71,264,183,112,117,259,176,280,155,99,261,77,78,53,104,0,223,253,83,211,121,244,223,131,23,123,102,213,93,240,45,178,287,73,282,34,296,190,180,271,173,73,258,22,132,228,73,113,119,158,81,174,63,23,269,33,196,271,69,285,254,132,148,231,251,115,58,98,124,45,186,29,61,208,151,55,298,141,1,128,86,226,268,247,53,32,3,45,113,56,294,262,175,219,43,77,8,249,235,238,100,135,167,241,169,61,62,109,172,103,158,128,172,15,164,62,289,280,298,252,123,242,297,77,52,209,5,102,208,33,33,87,120,168,93,88,243,93,113,120,253,123,218,198,122,286,194,155,67,175,225,137,272,85,200,267,84,110,4,88,296,229,174,182,80,152,238,258,28,163,125,22,135,210,150,122,284,296,178,160,185,26,55,85,5,45,126,165,168,235,12,122,17,93,181,155,179,99,273,231,173,129,220,49,17,73,228,286,103,205,238,10,239,145,62,181,273,284,196,4,199,290,2,287,22,88,175,243,12,16,169,94,124,153,220,135,97,22,123,172,229,174,196,243,125,239,217,208,219,57,232,21,74,286,246,66,55,71,278,77,77,215,200,232 209,294,73,160,32,300,203,4,173,30,31,240,85,13,89,114,90,285,294,120,83,48,49,194,123,124,214,98,190,62,55,175,24,137,272,78,236,114,87,276,190,188,128,29,168,209,275,251,6,163,275,129,204,151,154,139,106,121,81,16,73,294,18,117,109,147,46,142,77,189,163,47,282,197,152,117,32,235,138,226,179,250,5,63,22,31,99,38,0,161,197,163,249,24,57,204,136,107,45,212,279,159,26,228,120,139,148,62,99,28,177,51,279,29,133,82,262,225,82,202,77,27,9,97,237,89,70,144,76,102,13,145,62,260,177,227,279,99,163,24,190,123,289,34,277,186,104,44,144,66,299,39,8,103,164,277,162,122,255,248,202,217,300,102,149,124,209,53,127,163,245,162,128,153,68,186,147,204,266,111,91,88,45,159,67,175,109,263,143,57,205,224,184,235,48,243,60,287,19,18,238,114,139,35,34,52,14,215,160,168,65,140,224,226,120,271,224,26,191,214,4,129,120,82,296,241,209,125,221,83,107,130,284,36,194,104,31,55,23,130,288,163,148,292,65,114,119,84,151,41,155,290,167,273,197,132,208,19,227,210,149,46,67,98,236,15,155,227,241,97,292,242,203,272,263,125,37,287,239,209,120 Using a dictionary to handle the dupes, using this code Sub PickSample(intSampleSize As Integer, intPicks As Integer) Dim dicPicked As New Scripting.Dictionary Dim arr() As String Dim intCounter As Integer Dim intPicked As Integer ReDim arr(intPicks) For intCounter = 0 To UBound(arr) RetryPick: intPicked = CStr(Int((intSampleSize - (i - 1)) * Rnd + 1) + (i - 1)) If dicPicked.Exists(CStr(intPicked)) Then GoTo RetryPick Else dicPicked.Add CStr(intPicked), 1 arr(intCounter) = intPicked End If Next intCounter Debug.Print Join(arr(), ",") dicPicked.RemoveAll Set dicPicked = Nothing End Sub Gives results, hopefully dupe free PickSample 300,280 203,125,69,114,26,208,39,219,36,174,220,113,24,74,104,282,128,112,223,205,200,147,44,143,152,162,157,300,70,54,108,177,13,276,153,91,7,168,89,145,127,12,16,257,187,229,61,213,117,214,254,171,59,242,23,51,224,52,185,165,193,189,21,296,63,173,160,280,190,232,235,141,256,56,87,98,32,5,267,195,77,120,197,82,288,68,57,136,132,182,122,15,47,48,261,96,110,258,49,105,155,86,186,97,225,80,264,140,11,46,199,230,275,19,34,83,222,66,116,294,298,259,292,271,272,84,115,101,124,43,183,71,289,291,25,188,55,158,150,216,243,92,58,0,290,148,255,149,250,167,27,233,228,265,9,299,65,283,62,88,207,240,109,179,161,178,268,278,175,139,237,234,169,297,269,281,184,262,270,164,202,279,253,295,196,212,8,274,159,75,172,163,130,38,154,73,99,247,249,263,273,67,40,20,221,138,14,33,218,286,227,251,94,166,209,156,211,37,137,90,131,111,107,2,215,85,146,100,293,204,231,285,79,53,126,60,239,260,248,78,4,217,29,64,121,226,201,210,45,206,134,17,1,192,246,3,35,191,236,93,28,41,244,287,129,277,142,118,6,81,18,135,181,241,180,103,50,252,31,95,30 44,278,132,10,232,56,146,193,284,276,236,155,79,117,102,61,119,200,229,131,138,133,235,173,204,34,7,98,3,202,167,143,130,30,126,206,13,262,221,166,174,298,111,116,39,288,263,76,47,170,89,268,154,253,52,91,217,148,12,22,83,33,77,264,85,214,55,127,279,251,101,86,230,35,172,59,198,62,286,296,220,29,191,242,271,5,54,84,297,158,38,270,231,107,95,110,57,129,9,273,53,269,68,4,234,228,211,207,70,153,151,194,179,128,169,63,142,109,145,58,186,24,245,60,87,0,17,246,225,222,218,184,258,26,161,226,247,31,144,178,223,122,88,124,137,210,293,94,99,213,190,281,80,72,104,40,6,123,290,259,254,45,78,66,227,289,261,141,65,135,8,274,69,257,203,168,196,42,248,67,73,125,37,11,287,181,92,291,238,108,212,1,118,28,216,244,164,249,240,150,46,74,277,36,189,188,255,224,195,260,15,175,267,280,49,180,27,165,50,113,243,201,237,149,205,156,199,292,136,48,71,75,285,41,81,239,209,185,266,160,176,152,171,163,100,2,32,183,16,97,19,294,187,20,282,272,157,182,121,140,106,112,265,295,51,21,256,64,241,114,162,90,252,115,25,82,103,23,299,120,197 57,241,105,1,247,289,284,72,89,68,101,225,295,242,290,5,291,217,267,87,62,80,24,106,103,38,285,197,286,300,151,222,219,254,201,113,195,245,243,15,179,98,145,192,74,118,142,109,70,58,11,4,154,277,129,115,250,202,293,163,181,168,288,268,281,112,79,49,60,175,236,23,266,186,59,167,190,187,41,228,174,157,48,231,165,253,227,171,66,176,135,238,120,258,19,110,194,164,131,296,91,206,159,255,8,189,124,148,114,13,75,121,95,272,119,214,50,117,279,213,205,133,96,196,137,173,246,218,233,77,27,264,141,184,193,263,102,83,244,210,78,127,36,63,188,42,0,152,198,271,169,298,207,111,3,158,182,282,30,226,199,17,273,297,191,166,46,144,252,55,25,26,200,86,162,237,211,299,212,287,161,12,40,45,69,216,54,125,71,47,132,93,22,20,76,126,51,262,107,229,234,257,2,39,278,235,84,37,280,208,153,251,67,136,104,28,221,149,248,276,170,140,14,269,180,16,108,34,94,43,92,52,204,65,134,85,183,7,146,143,97,270,64,259,139,160,260,223,32,81,177,33,178,185,90,292,9,232,209,265,10,88,283,147,123,99,261,240,6,138,274,122,61,203,249,155,256,44,294,116,35
this function picks nItemsToPick random elements up from arr array and returns them into an array:
Function PickNRandomElementsFromArray(arr As Variant, nItemsToPick As Long) As Variant
Dim arrSize As Long
Dim i As Long, iPick As Long
Dim temp As String
arrSize = UBound(arr) '<--| count the values as the array size
If nItemsToPick > arrSize Then nItemsToPick = arrSize '<--| the items to be picked cannot exceed array size
For i = 1 To nItemsToPick
iPick = Int((arrSize - (i - 1)) * Rnd + 1) + (i - 1) '<--| pick a random number between 'i' and 'arrSize'
' swap array elements in slots 'i' and 'iPick'
temp = arr(iPick)
arr(iPick) = arr(i)
arr(i) = temp
Next i
ReDim Preserve arr(1 To nItemsToPick) '<--| resize the array to first picked items
PickNRandomElementsFromArray = arr '<--| return the array
End Function
which you can exploit as follows:
Option Explicit
Sub Authors()
Dim Authors As Variant, AuthorsList As Variant
With ThisWorkbook.Worksheets("Sheet") '<--| reference your relevant worksheet
Authors = Application.Transpose(.Range("A2", .Cells(.rows.count, 1).End(xlUp)).Value) '<--| fill 'Authors' array with its column "A" values from row 2 down to its last not empty one
AuthorsList = PickNRandomElementsFromArray(Authors, 280) '<--| fill 'AuthorsList' array with a selection of 280 random elements of 'Authors'
.Range("B1").Value = Join(AuthorsList, " OR ") '<--| fill cell "B1" with a string build by concatenating 'AuthorsList' values delimited with " OR "
End With
End Sub
that can be quite contracted (and made as much less readable) to:
Sub Authors()
With ThisWorkbook.Worksheets("Sheet") '<--| reference your relevant worksheet
.Range("B1").Value = Join(PickNRandomElementsFromArray(Application.Transpose(.Range("A2", .Cells(.rows.count, 1).End(xlUp)).Value), 280), " OR ")
End With
End Sub
From your comments, you seem to want to concatenate the array of strings, then put it back into excel. This, put just before the End Sub, will put it into cell B1 for example:
ThisWorkbook.Worksheets("Sheet1").Range("B1").Value = Join(Authorlist, "OR")
Excel VBA loop and get value from an array
I have the following code to retrieve a selection then making it a array of string. Dim strArgument As Variant Dim irange As Range Dim ricosString As Variant Set irange = Selection ricosString = RangeToStringArray(irange) Dim vArray As Variant For i = LBound(ricosString) To UBound(ricosString) Set vArray = ricosString(i) My problem here is on the ricosString(i). It is throwing an error Subscript out of range. Any ideas why? Here is the code for RangeToStringArray Public Function RangeToStringArray(theRange As Excel.Range) As String() Dim variantValues As Variant variantValues = theRange.Value Dim stringValues() As String ReDim stringValues(1 To UBound(variantValues, 1), 1 To UBound(variantValues, 2)) Dim columnCounter As Long, rowCounter As Long For rowCounter = UBound(variantValues, 1) To 1 Step -1 For columnCounter = UBound(variantValues, 2) To 1 Step -1 stringValues(rowCounter, columnCounter) = CStr(variantValues(rowCounter, columnCounter)) Next columnCounter Next rowCounter RangeToStringArray = stringValues End Function
RangeToStringArray is 2 dimensional but you reference it as 1 dimensional Set vArray = ricosString(i) Also Ricostring is not an object so you should not use Set
Regarding that RangeToStringArray function, I don't really see its interest: why don't you just use ricosString = irange, which would be simpler and faster?
Define your ricosString as a proper String Array: Dim ricosString() As String Replace your RangeToStringArray Function with a proper one: Public Function RangeToStringArray(theRange As Excel.Range) As String() Dim cell As Range Dim values() As String Dim i As Integer i = 0 ReDim values(theRange.Cells.Count) For Each cell In theRange values(i) = cell.Value i = i + 1 Next cell RangeToStringArray = values End Function Then you can refer to the values in the array like this: vArray = ricosString(i) 'without Set
VBA - How to make a queue in an array? (FIFO) first in first out
I am trying to make a queue which is able to show the first in first out concept. I want to have an array which works as a waiting list. The patients who come later will be discharged later. There is a limitation of 24 patients in the room the rest will go to a waiting list. whenever the room is empty the first patients from the waiting room (the earliest) goes to the room. Here is the code that I have come up with so far. Any help is greatly appreciated. Dim arrayU() As Variant Dim arrayX() As Variant Dim arrayW() As Variant Dim LrowU As Integer Dim LrowX As Integer Dim LrowW As Integer 'Dim i As Integer Dim j As Integer Dim bed_in_use As Integer LrowU = Columns(21).Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row LrowX = Columns(24).Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row LrowW = Columns(23).Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row ReDim arrayU(1 To LrowU) ReDim arrayX(1 To LrowX) ReDim arrayW(1 To LrowW) For i = 3 To LrowU arrayU(i) = Cells(i, 21) Next i i = 3 For i = 3 To LrowX arrayX(i) = Cells(i, 24) Next i i = 3 j = 3 For r = 3 To LrowW arrayW(r) = Cells(r, 23) Next r r = 3 i = 3 j = 3 For i = 3 To LrowX ' the number of bed in use is less than 24 (HH) If bed_in_use >= 24 Then GoTo Line1 For j = 3 To LrowU If bed_in_use >= 24 Then GoTo Line1 If arrayX(i) = arrayU(j) Then If Wait_L > 0 Then Wait_L = Wait_L - (24 - bed_in_use) Else bed_in_use = bed_in_use + 1 End If End If Next j Line1: For r = 3 To LrowW If bed_in_use < 24 Then Exit For If arrayX(i) = arrayW(r) Then bed_in_use = bed_in_use - 1 Wait_L = Wait_L + 1 End If Next r Cells(i, "Y").Value = bed_in_use Cells(i, "Z").Value = Wait_L Next i
Easiest way to do this would be to implement a simple class that wraps a Collection. You could wrap an array, but you'd end up either having to copy it every time you dequeued an item or letting dequeued items sit in memory. In a Class module (I named mine "Queue"): Option Explicit Private items As New Collection Public Property Get Count() Count = items.Count End Property Public Function Enqueue(Item As Variant) items.Add Item End Function Public Function Dequeue() As Variant If Count > 0 Then Dequeue = items(1) items.Remove 1 End If End Function Public Function Peek() As Variant If Count > 0 Then Peek = items(1) End If End Function Public Sub Clear() Set items = New Collection End Sub Sample usage: Private Sub Example() Dim q As New Queue q.Enqueue "foo" q.Enqueue "bar" q.Enqueue "baz" Debug.Print q.Peek '"foo" should be first in queue Debug.Print q.Dequeue 'returns "foo". Debug.Print q.Peek 'now "bar" is first in queue. Debug.Print q.Count '"foo" was removed, only 2 items left. End Sub
Would you not follow Comintern's "Class" approach (but I'd go with it!) you can stick to an "array" approach like follows place the following code in any module (you could place it at the bottom of you code module, but you'd be better placing it in a new module to call, maybe, "QueueArray"...) Sub Clear(myArray As Variant) Erase myArray End Sub Function Count(myArray As Variant) As Long If isArrayEmpty(myArray) Then Count = 0 Else Count = UBound(myArray) - LBound(myArray) + 1 End If End Function Function Peek(myArray As Variant) As Variant If isArrayEmpty(myArray) Then MsgBox "array is empty! -> nothing to peek" Else Peek = myArray(LBound(myArray)) End If End Function Function Dequeue(myArray As Variant) As Variant If isArrayEmpty(myArray) Then MsgBox "array is empty! -> nothing to dequeue" Else Dequeue = myArray(LBound(myArray)) PackArray myArray End If End Function Sub Enqueue(myArray As Variant, arrayEl As Variant) Dim i As Long EnlargeArray myArray myArray(UBound(myArray)) = arrayEl End Sub Sub PackArray(myArray As Variant) Dim i As Long If LBound(myArray) < UBound(myArray) Then For i = LBound(myArray) + 1 To UBound(myArray) myArray(i - 1) = myArray(i) Next i ReDim Preserve myArray(LBound(myArray) To UBound(myArray) - 1) Else Clear myArray End If End Sub Sub EnlargeArray(myArray As Variant) Dim i As Long If isArrayEmpty(myArray) Then ReDim myArray(0 To 0) Else ReDim Preserve myArray(LBound(myArray) To UBound(myArray) + 1) End If End Sub Public Function isArrayEmpty(parArray As Variant) As Boolean 'http://stackoverflow.com/questions/10559804/vba-checking-for-empty-array 'assylias's solution 'Returns true if: ' - parArray is not an array ' - parArray is a dynamic array that has not been initialised (ReDim) ' - parArray is a dynamic array has been erased (Erase) If IsArray(parArray) = False Then isArrayEmpty = True On Error Resume Next If UBound(parArray) < LBound(parArray) Then isArrayEmpty = True Exit Function Else isArrayEmpty = False End If End Function then in your main sub you could go like this: Option Explicit Sub main() Dim arrayU As Variant Dim arrayX As Variant Dim arrayW As Variant Dim myVar As Variant Dim j As Integer, i As Integer, R As Integer Dim bed_in_use As Integer, Wait_L As Integer Dim arrayXi As Variant Const max_bed_in_use As Integer = 24 'best to declare a "magic" value as a constant and use "max_bed_in_use" in lieu of "24" in the rest of the code 'fill "queue" arrays With ActiveSheet arrayU = Application.Transpose(.Range(.cells(3, "U"), .cells(.Rows.Count, "U").End(xlUp))) 'fill arrayU arrayX = Application.Transpose(.Range(.cells(3, "X"), .cells(.Rows.Count, "X").End(xlUp))) 'fill arrayX arrayW = Application.Transpose(.Range(.cells(3, "W"), .cells(.Rows.Count, "W").End(xlUp))) 'fill arrayW End With 'some examples of using the "queue-array utilities" bed_in_use = Count(arrayU) 'get the number of elements in arrayU Enqueue arrayU, "foo" ' add an element in the arrayU queue, it'll be placed at the queue end Enqueue arrayU, "bar" ' add another element in the arrayU queue, it'll be placed at the queue end bed_in_use = Count(arrayU) 'get the update number of elements in arrayU Dequeue arrayU 'shorten the queue by removing its first element myVar = Dequeue(arrayU) 'shorten the queue by removing its first element and storing it in "myvar" bed_in_use = Count(arrayU) 'get the update number of elements in arrayU MsgBox Peek(arrayU) ' see what's the first element in the queue End Sub
type mismatch assigning range to 1d array
I've got a range in a text format containing values and numbers. I am trying to assign the numbers only to an array and then I will assign the text values to another array without having to loop through the range. However, this code says - type mismatch?
Sub Igra()
Dim Arr() As Variant
'convert the range values from text to general
Sheets("Sheet1").Range("R32:W32").NumberFormat = "General"
Sheets("Sheet1").Range("R32:W32").Value = Sheets("Sheet1").Range("R32:W32").Value
' assign only the numbers to the array
Arr = Sheets("Sheet1").Range("R32:W32").SpecialCells(xlCellTypeConstants, xlNumbers).Value
End Sub
This should work then
Dim Arr() As Variant
Sheets("Sheet1").Range("R32:W32").SpecialCells(xlCellTypeConstants, xlNumbers).Copy
Sheets("Sheet1").Range("A1").PasteSpecial xlValues
Arr = Range(Range("A1"), Range("A1").End(xlToRight))
Dim R As Long
Dim C As Long
For R = 1 To UBound(Arr, 1) ' First array dimension is rows.
For C = 1 To UBound(Arr, 2) ' Second array dimension is columns.
MsgBox Arr(R, C)
Next C
Next R
Try this
Sub Sample()
Dim ws As Worksheet
Dim Arr() As Variant
Dim rng As Range, cl As Range
Dim n As Long, i As Long
Set ws = ThisWorkbook.Sheets("Sheet1")
Set rng = ws.Range("R32:W32")
n = Application.WorksheetFunction.Count(rng)
If n = 0 Then Exit Sub
ReDim Arr(1 To n)
i = 1
For Each cl In rng
If IsNumeric(cl.Value) Then
Arr(i) = cl.Value
i = i + 1
End If
Next cl
'~~> Only for demonstration purpose
For i = 1 To n
Debug.Print Arr(i)
Next i
End Sub