I am working with Dates as my data and I think this may be causing some issues.
Sub test()
Dim counter As Long
For counter = 1 to 10
Dim fltArr(0 to 9)
Dim X
Dim Largest As Date
For items = 3 to 12
fltArr(items-3) = Cells(items, 6)
Next
X = fltArr
Largest = Application.Large(X, counter)
Next
End Sub
A mismatch Error seems to occur in the line
Largest = Application.Large(X, counter)
I think this may be due to Application.Large giving an integer instead of a Date. How could I fix this?
The only difference between Value2 property and the Value property is that the Value2 property doesn't use the Currency and Date data types. You can return values formatted with these data types as floating-point numbers by using the Double data type. Reference
All you have to do is change the line
fltArr(items-3) = Cells(items, 6)
to
fltArr(items-3) = Cells(items, 6).Value2
Try this
Sub test()
Dim counter As Long
Dim Largest As Date
For counter = 1 To 10
Dim fltArr(0 To 9) As Variant
Dim X As Variant
For items = 3 To 12
fltArr(items - 3) = Cells(items, 6).Value2
Next
X = fltArr
Largest = Application.Large(X, counter)
Debug.Print Largest
Next
End Sub
Large does not like to work with Date Arrays. If you declare the arrays as doubles it will return the values you want(Using your code):
Sub test()
Dim counter As Long
For counter = 1 To 10
Dim fltArr(0 To 9) As Double
Dim X() As Double
Dim Largest As Date
For items = 3 To 12
fltArr(items - 3) = Cells(items, 6)
Next
X = fltArr
Largest = Application.Large(Range("F3:F12"), counter)
Debug.print Largest
Next
End Sub
Related
I'm completely new to VBA and I'm been trying to make basic problems to practice.
I just wanna fill a column with sequential numbers from 1 to N. The N number will be a value on an specific cell.
So the N value is on the C4 cell for example is 5 , and I wanna output from B2 - BN = 1,2,3,4,5
I have this code based on kinda similar questions and my knowledge of cycles but I can't make it work...
Sub ejemplo()
Dim total() As Variant
maximo = Range("C4").Value
For i = 1 To maximo
total(i) = i
Next i
total = Application.WorksheetFunction.Transpose(total)
Range("B7:B").Value = total
End Sub
The error that sometimes pop out is "out of range" on the total(i) = i line, I really don't know what's happening...
Array to Worksheet
In all three cases instead of For i = ... you can use: For i = LBound(total) To UBound(total).
Transpose is limited to a maximum of 65536 items, so study the
third solution which doesn't use it.
The Code
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Writes the numbers from 1 to "maximo" to the column range
' starting with cell "B7".
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 1D array (0-based, 'one-row')
Sub ejemplo1()
Dim total() As Variant
Dim maximo As Long
Dim i As Long
maximo = Range("C4").Value
ReDim total(maximo - 1)
For i = 0 To maximo - 1
total(i) = i + 1
Next i
total = Application.Transpose(total)
Range("B7").Resize(UBound(total)).Value = total
End Sub
' 1D array (1-based, 'one row')
Sub ejemplo2()
Dim total() As Variant
Dim maximo As Long
Dim i As Long
maximo = Range("C4").Value
ReDim total(1 To maximo)
For i = 1 To maximo
total(i) = i
Next i
total = Application.Transpose(total)
Range("B7").Resize(UBound(total)).Value = total
End Sub
' 2D array (1-based, 'one column')
Sub ejemplo3()
Dim total() As Variant
Dim maximo As Long
Dim i As Long
maximo = Range("C4").Value
ReDim total(1 To maximo, 1 To 1)
For i = 1 To maximo
total(i, 1) = i
Next i
Range("B7").Resize(UBound(total)).Value = total
End Sub
Pretty close:
Sub ejemplo()
Dim total As Variant
maximo = Range("C4").Value
ReDim total(1 To maximo) As Long
For i = 1 To maximo
total(i) = i
Next i
total = Application.WorksheetFunction.Transpose(total)
Range("B7").Resize(maximo, 1).Value = total
End Sub
NOTE:
the ReDim statement
the statement with Resize
EDIT#1:
If you are using Excel 365, then the code can be reduced to a single line:
Sub NoLoops()
Range("B7").Formula2 = "=SEQUENCE(" & Range("C4").Value & ",1,1,1)"
End Sub
The standard method for counting is
i = i + 1
As you repeatedly call this function i counts up. Applied to your problem, the loop For i = 1 To maximo would count the numbe of loops but it doesn't give the initial i, the number to start from. Therefore, what you need is this:-
Dim MyNumber As Integer
Dim i As Integer
MyNumber = 0
For i = 1 To maximo
MyNumber = MyNumber + 1
Next i
The next task is to define the cells to write to. It's basically the same logic. You need a point to start from, say B2.
Dim StartCell As Range
Set StartCell = Range("B2")
And now you can put it all together.
Dim Maximo As Integer
Dim StartCell As Range
Dim MyNumber As Integer
Dim i As Integer
Maximo = Range("C4").Value
MyNumber = 0
Set StartCell = Range("B2")
For i = 1 To maximo
MyNumber = MyNumber + 1
StartCell.Offset(0, i - 1).Value = MyNumber
Next i
I'd always recommend to at least be explicit about your Worksheet reference. I'd use a With statement making use of the sheet's CodeName.
Furthermore, I'd like to add another answer that creates an array through Evaluate(). While this function has a limit of 255 chars, in this exercise that would never be at risk.
Sub Test()
Dim total As Variant
With Sheet1
total = .Evaluate("ROW(1:" & .[C4] & ")")
.Range("B7").Resize(UBound(total)).Value = total
End With
End Sub
Once you are comfortable with what you are looking at here, you can do this in one shot without (IMO) ruining readability:
With Sheet1
.Range("B7").Resize(.[C4]).Value = .Evaluate("ROW(1:" & .[C4] & ")")
End With
Have a 2d Array, need to search through one of the columns finding a string and deleting everything after it.
I have a list of dates, but the format it is currently in has a long Time value
after the date ending in 2019. I would like to find and replace 2019 + time
with just 2019.
Edit code
The date isn't stored as a date, for all intents and purposes it's a string that looks something like "****#### 2019 ######" and I am just looking for a method to remove everything after a value, (2019) .
Right now, it steps through it all nicely checks array value by value
but doesn't actually change anything.
Edit2
Found workable solution using Instr & Split functions.
BUT the weirdest bug crept in,
some dates appear fine in debug.print
eg : 11/06/2019 BUT after printing to a range 06/11/2019
13/06/2019 13/06/2019
Even if the format of the destination is pre-defined
Public Sub PrintArray(Data As Variant, Cl As Range)
Cl.Resize(UBound(Data, 1), UBound(Data, 2)) = Data
End Sub
Private Sub Test()
Dim Name_col As Integer
Dim Date_col As Integer
Dim Hours_col As Integer
Dim Department_col As Integer
Dim Data_row As Integer
Name_col = 1
Date_col = 2
Hours_col = 3
Department_col = 4
Data_row = 2
Dim i As Integer
Dim zom As Integer
Dim DirArray As Variant
Dim col As Integer
Dim LString As String
Dim LArray() As String
zom = 0
i = 2
col = 2
Dim X As Integer
Application.ScreenUpdating = False
Do While Sheets("Sheet2").Cells(i, 1).Value <> ""
i = i + 1
zom = zom + 1
Loop
Application.ScreenUpdating = True
NumberOfZombies = zom
Debug.Print "Number of zombies" & NumberOfZombies
Worksheets("Sheet2").Activate
DirArray = Sheets("Sheet2").Range(Cells(Data_row, Name_col), Cells(zom, Department_col)).Value
For rw = LBound(DirArray) To UBound(DirArray)
For col = LBound(DirArray) To UBound(DirArray, 2)
LString = DirArray(rw, col)
If InStr(LString, "2019") > 0 Then
LArray = Split(LString)
Debug.Print LArray(0)
DirArray(rw, col) = LArray(0)
End If
Debug.Print DirArray(rw, col)
Next
Next
PrintArray DirArray, Sheets("Sheet3").[A1]
End Sub
I'm trying to run through a column of values, compare it to a supplied string, if it matches the string, add the value 4 columns over into an array, then sum the array at the end of the function.
The function exits out (not fails) at the ReDim Preserve line.
If I comment that out, it fails at the SumArray(Count) line.
What am I missing?
'Function used to SUM
Public Function TotalSum(prefix As String, rng As Range) As Integer
Dim BookofDaveSum As Dictionary
Set BookofDaveSum = New Dictionary
Dim SumArray As Variant
Dim Count As Long
Dim cell As Range
Dim i As Integer
Count = 0
For Each cell In rng
If Left(cell.Value, 7) = prefix Then
If Not BookofDaveSum.Exists(cell.Value2) Then
BookofDaveSum.Add cell.Value2, 0
ReDim Preserve SumArray(0 To Count)
SumArray(Count) = cell.Offset(0, 4)
Count = Count + 1
End If
End If
Next cell
TotalSum = Application.WorksheetFunction.Sum(SumArray)
End Function
Since you are iterating the range you are not gaining anything by using the array. Simply keep a running total:
Public Function TotalSum(prefix As String, rng As Range) As Integer
Dim BookofDaveSum As Dictionary
Set BookofDaveSum = New Dictionary
Dim cell As Range
For Each cell In rng
If Left(cell.Value, 7) = prefix Then
If Not BookofDaveSum.Exists(cell.Value2) Then
TotalSum = TotalSum + cell.Offset(0, 4).Value2
End If
End If
Next cell
End Function
If your concern is speed then convert both ranges to arrays and iterate the array:
Public Function TotalSum(prefix As String, rng As Range) As Long
Dim BookofDaveSum As Dictionary
Set BookofDaveSum = New Dictionary
Dim chRng As Variant
chRng = rng.Value2
Dim addRng As Variant
addRng = rng.Offset(, 4).Value2
Dim temp As Long
temp = 0
Dim i As Long
For i = LBound(chRng, 1) To UBound(chRng, 1)
If Left(chRng(i, 1), 7) = prefix Then
If Not BookofDaveSum.Exists(chRng(i, 1)) Then
temp = temp + addRng(i, 1)
End If
End If
Next cell
TotalSum = temp
End Function
Also this can be done with a formula:
=SUMPRODUCT(((LEFT(A1:A10,7)="abcdefg")*(E1:E10))/(COUNTIFS(A1:A10,A1:A10,A1:A10,"abcdefg" &"*")+(LEFT(A1:A10,7)<>"abcdefg")))
Where abcdefg is your prefix, A1:A10 is the string to test and E1:E10 the values to add
Dim SumArray() As Variant you are trying to redim a variable not an array. () indicates you want an array of variants.
I am trying to compare two different dynamic arrays in two different excel sheets I was able to assign value to the first but for the second one I am getting a run time error 9 subscript out of range
Sub sortandmark()
Dim x As Long, xg As Long
Dim Lfo() As String
Dim Greenlfo() As String
Dim i As Long, ig As Long
Dim j As Integer, jg As Long
Dim site As Long
'Get the main array
Windows("Test LFO sheet .xlsm").Activate
'x = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Rows.Count
ReDim Lfo(2 To 2, 3 To 5) As String
For i = 2 To 2
For j = 3 To 5
Lfo(i, j) = Cells(i, j).Value
Next j
Next i
Windows("LFO LIST FOR OCT test.xlsx").Activate
'Greenville array set up
Sheets("GRE").Select
xg = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Rows.Count
ReDim Greenlfo(2 To xg, 4 To 5)
For ig = 2 To xg
For jg = 3 To 4
Greenlfo(ig, jg) = ActiveSheet.Cells(ig, jg).Value ' Where the error occurs
Next jg
Next ig
'Testing and highlighting
If Lfo(i, 3) = Greenwood Then
Sheets("GRE").Select
End If
End Sub
I'm trying to cumulate the sums of values in an excel column of 4 values dimension (4,1).
So, I constructed the code below. For the first row in a column on the side Result, it is supposed to hold the same value as in the original Array.
But then, once it is greater than the first row, it is supposed to get the previous element of result (i-1) and add to it the current column element (i).
VBA is telling me that the subscript is out of range :/ and I cant figure out why... so I dont even know if my code does what I want.
Sub CumulativeSum()
Dim i As Integer
Dim j As Integer
Dim rColumn() As Variant
Dim result() As Variant
ReDim result(1 To 4)
rColumn = Worksheets("Sheet1").Range("E1:E4").Value2
For i = 1 To 4
result(1) = rColumn(1, 1)
For j = 2 To 3
result(j) = rColumn(j, 1) + result(j - 1)
Next j
Next i
Dim dest As Range
Set dest = Worksheets("Sheet1").Range("F1")
dest.Resize(4, 1).Value = result
End Sub
Sub CumulativeSum()
Dim dest As Range
Dim i As Integer
Dim j As Integer
Dim rColumn() As Variant
Dim result() As Variant
ReDim result(1 To 4)
rColumn = Worksheets("Sheet1").Range("E1:E4").Value2
result(1) = rColumn(1, 1)
For j = 2 To 4
result(j) = rColumn(j, 1) + result(j - 1)
Next j
Set dest = Worksheets("Sheet1").Range("F1")
dest.Resize(4, 1).Value = Application.Transpose(result)
End Sub
Don't have enough rep to add a comment but.. the reason why you're getting an error is because the Syntax for Cells is Cells([Row],[Column]). You're typing it in as Cells([Column],[Row]).
Try Range(Cells(1, 5), Cells(4, 5)) instead.