Looping through two ranges in one variant variable.
I am trying to read two ranges together at the same time using one variant. I have two ranges A and B, and I am combining them. After combining these two ranges, I am using a variant to read it. My variant variable only reading column A and ignoring Column B. Any suggestion what I am doing wrong.
Dim rngText as Range, rngText2 as Range, results as Range, dText
Set rngText = wSheet3.Range(wSheet3.Range("A1"), wSheet3.Cells(Rows.Count, 1).End(xlUp))
Set rngText2 = wSheet3.Range(wSheet3.Range("B1"), wSheet3.Cells(Rows.Count, 2).End(xlUp))
Set results = Union(rngText, rngText2)
dText = results.Value
For i = 1 to Ubound(dText,1)
'other condition here....
Next i
For i = 1 to Ubound(dText,1)
This loop iterates the first dimension of dText, which is declared as an implicit Variant.
dText = results.Value
This assigns the Variant with a 2D array representing the result of the Union operation. Unless a Range is representing a single cell, Range.Value always returns a 2D array.
You need a nested loop to iterate both dimensions of your 2D array.
Dim currentRow As Long
For currentRow = 1 To UBound(dText, 1)
Dim currentCol As Long
For currentCol = 1 To UBound(dText, 2)
' do stuff
Next
Next
Depending on what you're trying to achieve, it might be better to only iterate rows, and have your loop body's logic get the column indices:
Dim currentRow As Long
For currentRow = 1 To UBound(dText, 1)
Debug.Print "Column A: " & dText(currentRow, 1), "Column B: " & dText(currentRow, 2)
Next
Note that the 2D array holds Variant values representing whatever value/type that's held in the cells: if a cell contains a number, the array index will point to some Variant/Double; if a cell contains a string, the array index will point to some Variant/String; if a cell contains an error, the array index will point to some Variant/Error - and that last point is critical: you'll want to validate that the cell value doesn't contain an error before you assume its type and do anything with it (e.g. the above string-concatenation would fail with run-time error 13 / "type mismatch" given a Variant/Error value in either column, because a String can't be compared to or otherwise converted [implicitly or explicitly] to an Error). This would be safer:
Dim currentRow As Long
For currentRow = 1 To UBound(dText, 1)
If Not IsError(dText(currentRow, 1) And Not IsError(dText(currentRow, 2)) Then
Debug.Print "Column A: " & dText(currentRow, 1), "Column B: " & dText(currentRow, 2)
End If
Next
I ended up defining another loop. That's how I did it, before i was trying to do it in one loop but didn't work.
Set rngText = wSheet3.Range(wSheet3.Range("A1"), wSheet3.Cells(Rows.Count, 1).End(xlUp))
Set rngText2 = wSheet3.Range(wSheet3.Range("B1"), wSheet3.Cells(Rows.Count, 2).End(xlUp))
dText = rngText.Value
dText2= rngText2.Value
For i = 1 to Ubound(dText,1)
'do stuff
Next i
'second loop
For ii = 1 to Ubound(dText2,1)
'do stuff
Next ii
Related
Im trying to write a code which determines whether certain cells are empty or not and then returns a set string.
To go in detail; I was hoping for the code to look into cell B2, determine if it is empty, then go to C2 and determine if it is non-empty. If both were correct in cell B2 it would then input "Correct" and move on in the range. However, my code doesnt seem to work because it just inputs "Correct" in every cell in the loop range.
I have posted my code below; any help would be much appreciated.
Sub Fill_Rows()
Dim X As Range
Let Y = Range("C2")
For Each X In Range("B2:B5000")
If X = "" And Y <> "" Then
X = "Correct"
End If
Y = Y + 1
Next X
End Sub
If you meant to check by each row like (B2 and C2) then (B3 and C3), then you could do it like this.
Sub Fill_Rows()
Dim iRow As Long
For iRow = 2 To 5000
If Cells(iRow, "B").Value = vbNullString And Cells(iRow, "C").Value <> vbNullString Then
Cells(iRow, "B").Value = "Correct"
End If
Next iRow
End Sub
Alternative
Added two solutions:
[1] an example code as close as possible to yours and
[2] an alternative using a datafield array to demonstrate a faster way for bigger data sets.
[1] Example Code close to yours
There is no need to use a second variable Y, all the more as apparently you left it undeclared, which always can cause issues (type mismatches, no range object etc.).
So always use Option Explicit in the declaration head of your code module to force yourself to declare all variable types you are using.
Now you can simply use an offset of 1 column to the existing cell to check the neighbouring cell, too.
Option Explicit ' declaration head of your code module (obliges to declare variables)
Sub Fill_RowsViaRangeLoop()
Dim X As Range, ws As Worksheet
Set ws = ThisWorkbook.Worksheets("MySheet") ' << replace with your sheet name
For Each X In ws.Range("B2:B5000")
If X = "" And X.Offset(0, 1) <> "" Then ' column offset 1 checks next cell in C
X = "Correct"
End If
Next X
End Sub
[2] Example Code using a datafield array
Looping through a bigger range isn't very fast, you can speed up your procedure by
assigning your range values to a variant datafield array v, loop through the received array items correcting found items in column 1 and write it back to sheet.
Option Explicit ' declaration head of your code module (obliges to declare variables)
Sub Fill_RowsViaArray()
Dim v As Variant, i As Long, ws As Worksheet
Set ws = ThisWorkbook.Worksheets("MySheet") ' << replace with your sheet name
' Assign values to a 2-dim array
v = ws.Range("B2:C5000") ' or better: v = ws.Range("B2:C5000").Value2
' Check criteria looping over all rows (=first array dimension)
For i = 1 To UBound(v) ' data field arrays are one-based, i.e. they start with 1
If v(i, 1) = vbNullString And v(i, 2) <> vbNullString Then v(i, 1) = "Correct"
Next i
' Write edited array back to original range (adapt the range size to the array boundaries in both dimensions)
ws.Range("B2").Resize(UBound(v, 1), UBound(v, 2)) = v
End Sub
Further Notes
It's good use to fully qualify your sheet or range references (see e.g. object variable ws)
Each array item is identified by a row and a column index.
As such a datafield array is one based (start indices are 1), the first item in row 1 and column 1 will be referred by v(1,1), in col 2 by v(1,2).
In order to count the number of row items you check the upper boundary of its first dimension) via UBound(v,1) or even shorter via Ubound(v)
In order to count the number of columns you check the upper boundary of its second dimension) via UBound(v,2) (here the argument 2 is necessary!)
A comparation using vbNullString can be preferred in coding to "" as it takes less memory (c.f. #PEH 's answer) .
I want to create a 2D variant array from data in a worksheet. The issue is The columns I want to use are not adjacent and the amount of elements exceeds 65,536. (the apparent limit for Application.Index() using an Array() as Arg3. How should I proceed?
I have an answer to this question that works for me. I have read a great deal on this topic and I am curious if anyone else has had significant success with any other methods, because they are out there.
One Very Fast Solution: .Evaluate()
Application.Index([Range/Array],[Row],[Column]) is an extremely useful function.
Answer:
Dim arr as Variant 'This is the array you want to create.
Dim varRows as Variant 'This will hold the rows want to index
Dim LastRow as Long 'This is the last row of data you are needing
LastRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row 'set the last row
varRows = Evaluate("row(1:" & LastRow & ")") 'Evaluate is the make or break here. You can modify your start row as well by changing the 1.
arr = Application.Index(Sheets("Sheet1").Cells, varRows, Array(1, 3, 5)) 'You can set your array to be any columns you want.
'arr will now be a 2D array arr(1 to varRows, 1 to 3) in this example.
This method is so very fast it is dumb. It beats the pants off of a For Loop.
I passed a Range in this example but an array can also be passed if you need to Slice out 1 or more columns into a new array
Slice columns from an existing array Of any Type!:
This creates a Variant array and variants are so easy to get and return to the sheet.
Dim arr as Variant 'This is the array you want to create.
Dim SmallerArr as Variant 'the new array
Dim varRows as Variant 'This will hold the rows want to index
Dim LastRow as Long 'This is the last row of data you are needing
LastRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row 'set the last row
varRows = Evaluate("row(1:" & LastRow & ")") 'Evaluate is the make or break here. You can modify your start row as well by changing the 1.
arr = Application.Index(Sheets("Sheet1").Cells, varRows, Array(1, 3, 5)) 'You can set your array to be any columns you want.
'read a single column into a new variant array
SmallerArr = Application.Index(arr, varRows, 1) 'You can set your array to be any columns you want.
'read multiple columns into a new variant array
SamllerArr = Application.Index(arr, varRows, Array(1, 2)) 'The columns must exist in arr or you will get an error.
Dim lngArr(1 To 100000, 1 To 3) As Long 'create 2D array of type long
'Fill array
For h = 1 To 3
For j = 1 To 100000
lngArr(j, h) = j * h
Next j
Next h
SamllerArr = Application.Index(lngArr, varRows, Array(1, 2)) 'The columns must
'we just turned a long array into a variant array!
'we can read it to the sheet without a For loop!
Read columns back to the sheet:
Dim arr as Variant 'This is the array you want to create.
Dim SmallerArr as Variant 'the new array
Dim varRows as Variant 'This will hold the rows want to index
Dim LastRow as Long 'This is the last row of data you are needing
LastRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row 'set the last row
varRows = Evaluate("row(1:" & LastRow & ")") 'Evaluate is the make or break here. You can modify your start row as well by changing the 1.
arr = Application.Index(Sheets("Sheet1").Cells, varRows, Array(1, 3, 5)) 'You can set your array to be any columns you want.
'Read 1 column to the sheet
Sheets("Sheet2").Range("A1:A" & LastRow) = Application.Index(arr, varRows, 1) ' cange the range and column accordingly
'Read multiple columns to the sheet
Sheets("Sheet2").Range("A1:B" & LastRow) = Application.Index(arr, varRows, Array(1, 2))
Notes:
1) varRows can be modified to accept any position of elements.
2) In Excel 2013 at least, when using Index() without passing arrays as arguments for row/column, there does not appear to be any row limitations.
3A) All arrays created this way are 2D. Even if they are 1 column they are still 1 wide.
3B) Application.Transpose() has row limitations as well just in case you were trying it...
I am not quite sure how to interpret the question but here is a method (two variations) of doing what I guess is asked for. This can be expanded/automated/adjusted as desired.
Sub ForJoshua1()
' Say, you want 2 columns: "B:B", "H:H"
Dim vX(1 To 2) As Variant
vX(1) = Range("B:B")
vX(2) = Range("H:H")
End Sub
Sub ForJoshua2()
' Say, you want 2 columns: 2, 8
Dim vX(1 To 2) As Variant
vX(1) = Sheet1.Columns(2)
vX(2) = Sheet1.Columns(8)
End Sub
If you have an "a" in the cell "B12", for example, then
vX(1)(12,1) would equal "a"
I don't know how to best describe this but it's better that I explain my problem in pictures.
I have 2 worksheets:
In worksheet Array, there are certain periods with their corresponding 'Array' associated with them.
In Sheet1, there is a list of strings in the format: dd/mm/yyyy hh:mm:ss AM/PM - # ordered by ascending order of number, then by date and finally by time.
The code I have, generates those values in Sheet1 by extracting the data in Array and listing them out in one cell. The code I've used is.
Sub Filter()
Const Array_FirstRow As Integer = 2 'Indicates the first row (row 2) in Array sheet
Dim Array_RowIndex As Integer 'variable to loop through array values of col A
Dim Summary_PeriodMoment1 As String 'in worksheet Sheet 1
Array_RowIndex = Array_FirstRow
Array_LastRow = Array_RowIndex - 1
Summary_PeriodMoment1 = ""
For Array_RowIndex = Array_FirstRow To Array_LastRow
If Summary_PeriodMoment1 <> " " Then
Summary_PeriodMoment1 = Summary_PeriodMoment1 & ", " & Worksheets("Array").Cells(Array_RowIndex, Array_DateTime_Column).Value
End If
Next
Sheet1.Cells(1, 1).Value = Summary_PeriodMoment1
End Sub
This is slightly confusing and overly complicated to read. Is there any way to add code to :
Sort/group the values by # and consolidate by date (to make it less confusing)? Like so?
Have a separate cell for each value, again categorized by # (I would like to plot these values on a pivot graph later on using other code, so would like it to be in a friendly format
Essentially I would like to do some data reformatting/transposing with a VBA script. Any idea what functions I should use? thanks!
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Update: I have what I need for transposing a string of values in one cell. I wonder if this can be done for multiple cells. I tried using this code:
Sub TextToRows()
'Code for 1.2. section
Dim Arr As Variant
Dim Arr1 As Variant
Dim Arr2 As Variant
Dim InputRng As Range, InputRng2 As Range, InputRng3 As Range, OutputRng As Range, OutputRng1 As Range, OutputRng2 As Range
Set InputRng = Range("B1") 'Cell Containing all the text
Set InputRng1 = Range("B2")
Set InputRng2 = Range("B3")
Set OutputRng = Range("D1") 'First Cell of a column that you want the output there
Set OutputRng1 = Range("G1")
Set OutputRng2 = Range("J1")
Arr = Split(InputRng.Value, ",")
Arr1 = Split(InputRng.Value, ",")
Arr2 = Split(InputRng.Value, ",")
Set OutputRng = OutputRng.Resize(UBound(Arr) - LBound(Arr) + 1)
OutputRng.Value = Application.Transpose(Arr)
Set OutputRng1 = OutputRng1.Resize(UBound(Arr1) - LBound(Arr1) + 1)
OutputRng.Value = Application.Transpose(Arr1)
Set OutputRng2 = OutputRng2.Resize(UBound(Arr2) - LBound(Arr2) + 1)
OutputRng.Value = Application.Transpose(Arr2)
End Sub
Seems it only works for InputRng and not InputRng1 or InputRng2
1.
How to split comma-delimited data in one cell? (Look below)
1.1. If you don't have any other data, and number of records are not more than number of possible columns in excel then transposing within the worksheet is an option (Instead of using the code below).
1.2. (If you have more data than limit of excel columns): Otherwise, you need to use arrays. The code below answers first part of your question. It will split the cell for "," as delimiter.
2.
Then you can use Text to Columns in Data tab and delimiter ":" to get the numbers in one column and dates in another one.
3.
Use How To Transpose Cells In One Column Based On Unique Values In Another Column? to group them based on the numbers.
Sub TextToRows()
'Code for 1.2. section
Dim Arr As Variant
Dim InputRng As Range, OutputRng As Range
Set InputRng = Range("B1") 'Cell Containing all the text
Set OutputRng = Range("D1") 'First Cell of a column that you want the output there
Arr = Split(InputRng.Value, ",")
Set OutputRng = OutputRng.Resize(UBound(Arr) - LBound(Arr) + 1)
OutputRng.Value = Application.Transpose(Arr)
End Sub
I've done quite a bit of searching and can't find any code that matches my situation or to a point I can modify except for one.
Looking at the spreadsheet below. I want to have the user enter the OrderNumber then search Column A for every value of that number. As it does I want it to copy the ItemNumber and QtyOrdered to two different variables in order to put them into textboxes later on.
I want it to "stack" the information into the variable so something like ItemNumValues = ItemNumValues + Cell.Value
I tried to modify code from someone else ("their code") but I am getting a mismatch type error. The rest of the code works. There are some trace elements in the script from previous features that aren't used and I just haven't removed them yet.
'***********************************************************
'********** Their Code Follows *****************
'***********************************************************
Dim numentries As Integer
Dim i As Integer
'***********************************************************
'Get number of entries
numentries = Worksheets(Sheet1).UsedRange.Rows.Count
'*************************************************************
'Run loop to cycle through all entries (rows) to copy
For i = 1 To numentries
If (Worksheets("Sheet1").Cells(i + 2, 1).Value = InStr(1, Cell, OrderNumber, vbTextCompare)) Then
MsgBox Test
End If
Next i
End If
'***********************************************************
'********** End Their Code *****************
'***********************************************************
I recommend using a multidimensional array. If you've never used arrays before, I strongly suggest reading up on them.
Sub GatherData()
Dim c As Range
Dim aGetData() As Variant 'This is our array
Dim i As Integer
Dim a As Integer
Dim iRowCount As Integer
Dim sRange As String
'Gather data
iRowCount = Worksheets("Sheet1").UsedRange.Rows.Count
For Each c In Range("A2:A" & iRowCount)
If c.Value = 636779 Then
ReDim Preserve aGetData(2, i) 'An array must have a set size but as we
'do not know how many order numbers will be found we have to 'resize'
'the array to account for how many we do find. Using "ReDim Preserve"
'keeps any data we have placed into the array while at the same time
'changing it's size.
For a = 0 To 2 'Our first index will hold each col of data that is why
'it is set to 2 (arrays start at a base of zero, so
'0,1,2 will be each col(A,B,C)
aGetData(a, i) = c.Offset(0, a) 'This gets each value from col A,B and C
Next a
i = i + 1 'Increment for array in case we find another order number
'Our second index "aGetData(index1,index2) is being resized
'this represents each order number found on the sheet
End If
Next c
'How to read the array
For i = 0 To UBound(aGetData())
For a = 0 To 2
Debug.Print aGetData(a, i)
Next a
Next i
End Sub
It seems that the OrderNumber (column A) is sorted. Very good news (if they're not, just sort them ;) ). This simple function will get you the ItemNumbers and QtyOrdered into a bi-dimensional array, where each row is a pair of them.
Function ArrItemQty(ByVal OrderNumber As Long)
With Worksheets("Sheet1").UsedRange.Offset(1)
.AutoFilter 1, OrderNumber
ArrItemQty= .Resize(, 2).Offset(, 1).SpecialCells(xlCellTypeVisible).value
.Parent.AutoFilterMode = False
End With
End Function
And here's a little testing:
Sub Test()
Dim i As Long, j As Long, ar
ar = ArrItemQty(636779)
For i = LBound(ar, 1) To UBound(ar, 1)
Debug.Print
For j = LBound(ar, 2) To UBound(ar, 2): Debug.Print ar(i, j),: Next
Next
End Sub
p.s. be aware that the resulting array is 1-based. Use LBound and UBound as indicated is safest.
I have a column with nearly 100k and am trying to determine how many times a value occurs repeatedly in that column. I can do it row by row currently, but this is menial as a programmer, through something like =COUNTIF(D:D,D2). Yet that only returns D2 matches in column D.
I need to iterate through all values of D returning countif, therefore revealing all of the values repetitions in the column. I can remove duplicates later! So I have a dev. button a basic sub, or function (man this is new to me) and something along the lines of the most basic for loop ever. Just getting caught up on how to implement the COUNTIF() to to the loop properly.
Right now I'm looking at:
Sub doloop()
Dim i As Integer
i = 1
Do While i < D.Length
Cells(i, 8).Value =CountIf(D:D,D[i])
i = i + 1
Loop
End Sub
That code is incorrect obviously but it is where I'm at and may help for anyone more familiar with other languages.
Use Application.WorksheetFunction.CountIf() in your loop.
Private Sub doloop()
Dim lastRow As Long
Dim d As Double
Dim r As Range
Dim WS As Excel.Worksheet
Dim strValue As String
Dim lRow As Long
'Build your worksheet object
Set WS = ActiveWorkbook.Sheets("sheet1")
'Get the last used row in column A
lastRow = WS.Cells(WS.Rows.count, "D").End(xlUp).Row
'Build your range object to be searched
Set r = WS.Range("D1:D" & lastRow)
lRow = 1
WS.Activate
'Loop through the rows and do the search
Do While lRow <= lastRow
'First, get the value we will search for from the current row
strValue = WS.Range("D" & lRow).Value
'Return the count from the CountIf() worksheet function
d = Application.worksheetFunction.CountIf(r, strValue)
'Write that value to the current row
WS.Range("H" & lRow).Value = d
lRow = lRow + 1
Loop
End Sub
I believe you are trying to write the value to the cell, that is what the above does. FYI, if you want to put a formula into the cell, here is how that is done. Use this in place of WS.Range("H" & lRow).Value = d
WS.Range("H" & lRow).Formula = "=CountIf(D:D, D" & lRow & ")"
Sounds like you may want to look into using tables in Excel and capitalizing on their features like filtering and equation autofill. You may also be interested in using a PivotTable to do something very similar to what you're describing.
If you really want to go about this the programmatic way, I think the solution Matt gives answers your question about how to do this using CountIf. There's a big detriment to using CountIf though, in that it's not very computationally efficient. I don't think the code Matt posted will really be practical for processing the 100K rows mentioned in the OP (Application.ScreenUpdating = false would help some). Here's an alternative method that's a lot more efficient, but less intuitive, so you'll have to decide what suites your needs and what you feel conformable with.
Sub CountOccurances()
'Define Input and Output Ranges
'The best way to do this may very from case to case,
'So it should be addressed seperately
'Right now we'll assume current sheet rows 1-100K as OP specifies
Dim RInput, ROutput As Range
Set RInput = Range("D1:D100000")
Set ROutput = Range("E1:E100000")
'Define array for housing and processing range values
Dim A() As Variant
ReDim A(1 To RInput.Rows.Count, 0)
'Use Value2 as quicker more accurate value
A = RInput.Value2
'Create dictionary object
Set d = CreateObject("Scripting.Dictionary")
'Loop through array, adding new values and counting values as you go
For i = 1 To UBound(A)
If d.Exists(A(i, 1)) Then
d(A(i, 1)) = d(A(i, 1)) + 1
Else
d.Add A(i, 1), 1
End If
Next
'Overwrite original array values with count of that value
For i = 1 To UBound(A)
A(i, 1) = d(A(i, 1))
Next
'Write resulting array to output range
ROutput = A
End Sub
You can also modify this to include the removal of replicates you mentioned.
Sub CountOccurances_PrintOnce()
'Define Input and Output Ranges
'The best way to do this may very from case to case,
'So it should be addressed seperately
'Right now we'll assume current sheet rows 1-100K as OP specifies
Dim RInput, ROutput As Range
Set RInput = Range("D1:D100000")
Set ROutput = Range("F1:F9")
'Define array for housing and processing range values
Dim A() As Variant
ReDim A(1 To RInput.Rows.Count, 0)
'Use Value2 as quicker more accurate value
A = RInput.Value2
'Create dictionary object
Set d = CreateObject("Scripting.Dictionary")
'Loop through array, adding new values and counting values as you go
For i = 1 To UBound(A)
If d.Exists(A(i, 1)) Then
d(A(i, 1)) = d(A(i, 1)) + 1
Else
d.Add A(i, 1), 1
End If
Next
'Print results to VBA's immediate window
Dim sum As Double
For Each K In d.Keys
Debug.Print K & ": " & d(K)
sum = sum + d(K)
Next
Debug.Print "Total: " & sum
End Sub