Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 8 years ago.
Improve this question
I'm working with Arrays and trying to change the text value of an array to numerical for an easier evaluation as the code progress. I seem to be having issues with Arrays, but I'm not sure why. Can you take a look at my code and offer feedback?
Dim MonthlyValuesUnclean() As Range
Dim CodeCountOne As Long
Range("A1").Select
CodeCountOne = Application.CountA(Range("A:A")) 'Counts Total Number of Codes Before Clean
ReDim MonthlyValuesUnclean(CodeCountOne, 1 To 3)
For columnNumber = 1 To 3
ReDim MonthlyValuesUnclean(CodeCountOne, columnNumber)
For counter = 1 To CodeCountOne
If MonthlyValuesUnclean(counter, columnNumber).Text = "R" Then
MonthlyValuesUnclean(counter, columnNumber).Value = 5
ElseIf MonthlyValuesUnclean(counter, columnNumber).Text = "Y" Then
MonthlyValuesUnclean(counter, columnNumber).Value = 4
ElseIf MonthlyValuesUnclean(counter, columnNumber).Text = "G" Then
MonthlyValuesUnclean(counter, columnNumber).Value = 3
ElseIf MonthlyValuesUnclean(counter, columnNumber).Text = "?" Then
MonthlyValuesUnclean(counter, columnNumber).Value = 2
Else
MonthlyValuesUnclean(counter, columnNumber).Value = 1
End If
Next counter
Next columnNumber
What I am trying to do is take a range of cells and put them into the array.
OK, that's what I thought, but you haven't actually done that. You've defined an array of range objects (not what you want) and you have dimensioned that array probably correctly (but unnecessarily).
In this, we will first define and assign a range variable (monthlyValuesRange). Then, we will assign the range's .Value array to an array variable (MonthlyValuesUnclean). Then, we can process that array, and finally put those values back in to the worksheet.
Sub Test()
Dim MonthlyValuesUnclean As Variant
Dim CodeCountOne As Long
Dim monthlyValuesRange As Range
CodeCountOne = Application.CountA(Range("A:A")) 'Counts Total Number of Codes Before Clean
'Define your range variable
Set monthlyValuesRange = Range("A1:C" & CodeCountOne)
'Assigns the range's value array to the MonthlyValuesUnclean array variable:
MonthlyValuesUnclean = monthlyValuesRange.Value
For columnNumber = 1 To 3
For counter = 1 To CodeCountOne
'## I find Select statement easier to work with:
Select Case UCase(MonthlyValuesUnclean(counter, columnNumber))
Case "R"
MonthlyValuesUnclean(counter, columnNumber) = 5
Case "Y"
MonthlyValuesUnclean(counter, columnNumber) = 4
Case "G"
MonthlyValuesUnclean(counter, columnNumber) = 3
Case "?"
MonthlyValuesUnclean(counter, columnNumber) = 2
Case Else
MonthlyValuesUnclean(counter, columnNumber) = 1
End Select
Next counter
Next columnNumber
'Now put the updated values in the worksheet
monthlyValuesRange.Value = MonthlyValuesUnclean
End Sub
Tested & confirmed this is working as expected. Before:
After:
And an example of examining the MonthlyValuesUnclean in the VBE's locals window:
Related
Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 2 years ago.
Improve this question
I am looking across numerous columns and rows and inputting cell values of interest into a 1D array. I would just like to print this array of length 2020 into a single row on another worksheet. I am not sure why my program is not working, but I appreciate any help
Sub Math()
Dim FW_List() as Variant
x = 0
For i = 3 to 10
For j = 17 to 282
If Left(ws.Cells(j, i).Value, 3) = "0.7" And ws.Cells(j, i).Interior.Color <> 8696025 Then
ReDim Preserve FW_List(x)
FW_List(x) = ws.Cells(j, i).Value
x = x + 1
Next j
Next i
num = UBound(FW_List) - LBound(FW_List) + 1
Debug.Print num
wb.Sheets("JMP").Range("A1:A2020").Value = Application.WorksheetFunction.Transpose(FW_List)
End Sub
Your code is quite good but it lacks precision. Some of the changes I made are cosmetic, like the use of a With statement to shorten the code and thereby make it easier to read. But the nonchalance with which you approached variable naming probably caused your failure. Observe that I retained both structure and logic of your original code.
Sub Math()
Dim FW_List As Variant
Dim Ws As Worksheet
Dim C As Long ' loop counter: column
Dim R As Long ' loop counter: Row
Dim i As Long ' index of FW_List
Set Ws = ActiveSheet
ReDim FW_List(1 To 3000) ' any number larger than what you expect
For C = 3 To 10
For R = 17 To 282
With Ws.Cells(R, C)
If Left(.Value, 3) = "0.7" And .Interior.Color <> 8696025 Then
i = i + 1
FW_List(i) = .Value
End If
End With
Next R
Next C
If i Then
ReDim Preserve FW_List(i)
Worksheets("JMP").Cells(1, 1).Resize(1, i).Value = Application.Transpose(FW_List)
End If
End Sub
But here are two things you probably couldn't have known.
Dim FW_List As Variant creates a variant which, as you know, can be anything including an array. Therefore Dim FW_List() As Variant creates an array of such variants. Since any of its components can do what the whole structure does the idea isn't useful and therefore any difference it can make not beneficial.
When you Redim Preserve an array the entire array is re-written to a new one, element by element. As the size of your array grows to 2020 elements that process eats time if repeated 2000 times. Therefore my code creates an array intentionally larger than what is needed and then truncates unused elements - a process I believe is done without re-writing the array at all.
I have a a table of values, which list item ids by the amount of those items in different qualities, like so:
ID QB QC UI
006780 12 - 6
100780 48 15 8
And so on for a thousand rows. As part of a further wrangling effort, I wish to get the id's and move them elsewhere and position them under each other with 2 blank cells between them. This is the code I've come up with and please bear with me, I'm trying to lear:
Sub laatuJako()
Dim idRange As Range
Dim tyoWb As Workbook
Dim tyoWks As Worksheet
Dim idRivit As Integer
Dim idArray() As Variant
Set tyoWb = ThisWorkbook
Set tyoWks = tyoWb.Sheets("Pivots->Apu")
idRivit = tyoWks.Range("Q7").End(xlDown).Row
ReDim idArray(0)
Dim varCounter As Integer
varCounter = 0
This next loop is a way I could form the array, since it seemed to run into run-time error 9 in the next loop.
For i = 0 To idRivit - 1
tyoWks.Activate
idArray(i) = tyoWks.Range("Q" & 7 + i).Value
varCounter = varCounter + 1
ReDim Preserve idArray(varCounter)
Next i
Dim k As Integer
Dim j As Integer
k = 0
j = 0
Do While k < idRivit
tyoWks.Range("X" & 7 + j).Value = idArray(k)
j = j + 3
k = k + 1
Loop
End Sub
Now the code works, but it seems that (un)helpfully VBA changed the id attribute to a number and printed the ids with numbers in front of them, for example 006780 as 6780. This was not wanted and so I changed the array into a string array, but it made no difference. Now an array is not necessary here and I can just copy-paste them directly using a loop, but I want to understand how I can control something like this, since the issue will come up again in situations where an array would be preferable.
Apologies, if the question is poorly described, there is a first time for everything.
I have an array with multiple duplicates. I'm trying to write code that will produce a second array that contains the indexes of all of the elements in the first array that equal a look up value.
For example, I have this array:
1
1
1
2
2
2
2
2
3
3
4
5
6
6
7
I want a second array that will return the indexes of the number 6.
This is the code that I have right now.
Sub test()
Dim look_up As Integer
Dim id_ar As Variant
Dim index_ar As Variant
look_up = 6
id_ar = Range("A1:A16").Value
index_ar = Application.Match(id_ar, look_up, True)
End Sub
I want this to result in an array like this:
13
14
But it just returns a bunch of '#N/A's
Some extremely simple code may help you better than brief and concise approaches.
Definitions : arrOut is your desired output, rngLookup is where your number 6 and any others reside. rngDB is where you want to search for the indexes of the lookup values.
Option Explicit
Sub dupes()
Dim rngLookup, rngDB As Range
Dim i, j As Variant
Dim arrOut As New Collection
Set rngLookup = Worksheets("Sheet1").Range("B1")
Set rngDB = Worksheets("Sheet1").Range("A1:A14")
Dim counter As Integer
counter = 0
For Each i In rngLookup
For Each j In rngDB
counter = counter + 1
If j.Value = i.Value Then
arrOut.Add Item:=CInt(counter)
Else
End If
Next j
Next i
End Sub
I am working in VBA for Excel, and I have an array of integers. What I am trying to do is add 1 to a specific element inside the array when my conditions have been met. In my example code if the cell in column A is a 5 then I would like to add 1 in the 5th position of the array or if the cell is a 3 then add 1 to the 3rd position of the array.
Sub CountCustomers()
Dim myArray(5)
Dim i as integer
For i = 1 to 10
If Cells(i,1) = 5 Then
myArray(4) = myArray(4)+1
ElseIf Cells(i,1) = 3 Then
myArray(2) = myArray(2)+1
End If
Next
End Sub
When I run it like this it ends up with a 1 in the correct position but will not increase the values any higher. Is there a way to do this?
A couple of options below.
Better to work with arrays for speed than loops (option 2)
For this particular example you can use CountIF directly (option 1)
If you have multiple processing routes then Select can be more efficient than Else If
code #1
Sub Option1()
Debug.Print "number of 5's: " & Application.WorksheetFunction.CountIf([a1:a10], 5)
Debug.Print "number of 3's: "; Application.WorksheetFunction.CountIf([a1:a10], 3)
End Sub
code #2
Sub Option2()
Dim x
Dim myArray(1 To 5)
Dim lngCnt As Long
'put range into 2D variant array
x = [a1:a10].Value2
For lngCnt = 1 To UBound(x)
Select Case x(lngCnt, 1)
Case 5
myArray(4) = myArray(4) + 1
Case 3
myArray(2) = myArray(2) + 1
Case Else
'do nothing
End Select
Next
Debug.Print myArray(4), myArray(2)
End Sub
Your code works as expected. You should watch:Excel VBA Introduction Part 3 - What to do When Things Go Wrong (Errors and Debugging)
Here I set up watches to monitor your variables. The watches for myArray(2) and myArray(4) are set to break when there value changes.
I have the following problem in Excel while calculating through a loop:
I need a variable (Destination Variable) that sequentially stores the results produced after each loop has been completed (avoiding the use of circular references) that would look like this:
'Let's call it "origin" variable in the worksheet
Origin Variable (50 x 50 array)
1 2 4
2 3 4
2 2 3
'Let's call it "destination" variable in the worksheet
Destination Variable (50 x 50 array)
1 1 1
1 1 1
1 1 1
After each loop, I'd need the macro to perform the following code:
range("destination").value = range("destination").value + range("origin").value
So that the destination variable would look like this after the current loop:
Destination Variable
2 3 5
3 4 5
3 3 4
However, Excel does not allow me to perform the previous function.
Does anyone have an answer how this could be solved?
Quite easy. I did this by recording as macro and tidying.
Sub Macro1()
Range("origin").Copy
Range("destination").PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub
I like #S Meaden's answer, it is simple and I had not thought of that. And it certainly works for this purpose.
You could also do simple iteration. IN the example below I add two different ranges and put them in a third range, but this could be re-worked for your needs pretty easily, or it is another option if you ever need to add ranges to another range:
Sub AddArrays()
Dim rng1 As Range
Dim rng2 As Range
Dim rngSum As Range
Dim arr1 As Variant
Dim arr2 As Variant
Dim arrSum As Variant
Set rng1 = Range("A1:C7") '## Modify as needed
Set rng2 = Range("F1:H7") '## Modify as needed
Set rngSum = Range("K1:M7") '## Modify as needed
'Raises an error, Type Mismatch
'rngSum.Value = rng1.Value + rng2.Value
arr1 = rng1.Value
arr2 = rng2.Value
arrSum = rngSum.Value
Dim x As Integer, y As Integer
For x = LBound(arr1, 1) To UBound(arr1, 1)
For y = LBound(arr1, 2) To UBound(arr1, 2)
arrSum(x, y) = arr1(x, y) + arr2(x, y)
Next
Next
'Print result to sheet
rngSum.Value = arrSum
End Sub