Copy-paste loop with skipped values in VBA - loops

I am fairly new to code-writing in general and VBA in particular.
I have tried to write a fairly simple macro that copies values from one cell to another on a daily basis, however I am wondering if there is a way to have fewer variables for the loop counters, in other words, can a loop counter skip certain values?
Private Sub YesButton_Click()
Dim z As Integer
Dim z1 As Integer
Dim z2 As Integer
Dim z3 As Integer
Dim z4 As Integer
Dim z5 As Integer
Dim z6 As Integer
Dim z7 As Integer
Dim z8 As Integer
Dim z9 As Integer
Dim z10 As Integer
Dim z11 As Integer
Dim z12 As Integer
Dim z13 As Integer
Application.Calculation = xlCalculationManual 'turn off autocalc to speed up copy paste process
For z = 5 To 16
Sheet68.Range("H" & z) = Sheet68.Range("D" & z).Value
Next z
For z1 = 21 To 33
Sheet68.Range("H" & z1) = Sheet68.Range("D" & z1).Value
Next z1
For z2 = 38 To 51
Sheet68.Range("H" & z2) = Sheet68.Range("D" & z2).Value
Next z2
For z3 = 73 To 86
Sheet68.Range("H" & z3) = Sheet68.Range("D" & z3).Value
Next z3
For z4 = 92 To 94
Sheet68.Range("G" & z4) = Sheet68.Range("D" & z4).Value
Next z4
For z5 = 100 To 110
Sheet68.Range("G" & z5) = Sheet68.Range("D" & z5).Value
Next z5
For z6 = 115 To 126
Sheet68.Range("G" & z6) = Sheet68.Range("D" & z6).Value
Next z6
For z7 = 131 To 142
Sheet68.Range("G" & z7) = Sheet68.Range("D" & z7).Value
Next z7
For z8 = 149 To 151
Sheet68.Range("G" & z8) = Sheet68.Range("D" & z8).Value
Next z8
For z11 = 157 To 164
Sheet68.Range("G" & z11) = Sheet68.Range("D" & z11).Value
Next z11
For z9 = 169 To 175
Sheet68.Range("G" & z9) = Sheet68.Range("D" & z9).Value
Next z9
For z10 = 180 To 186
Sheet68.Range("G" & z10) = Sheet68.Range("D" & z10).Value
Next z10
For z12 = 191 To 203
Sheet68.Range("H" & z12) = Sheet68.Range("D" & z12).Value
Next z12
Application.Calculation = xlCalculationAutomatic 'turn autocalc back on
Unload Me
End Sub
Thanks in advance

Here's an example of how you could re-think your code. You will clearly need to readapt the sample to your own data.
Declare a vector of ranges
The size of it, as many as your intervals are (I counted 14 in your case, but I might be wrong).
Dim ranges(1 To 5)
Dim j As Integer '<-- counter of the ranges
Dim k As Long '<-- counter of your loop
Define your ranges
Here you define, as strings, your specific ranges. In my example I've put random numbers, but in your case should be "5-16", "21-23" etc.
ranges(1) = "1-2"
ranges(2) = "5-10"
ranges(3) = "15-20"
ranges(4) = "25-30"
ranges(5) = "35-40"
Nest two loops
The outside one will loop through the ranges, the inside one will split the ranges and use the lower and upper bounds to loop through your cells
For j = 1 To 5
For k = Split(ranges(j), "-")(0) To Split(ranges(j), "-")(1)
'your code here
'test it with a msgbox:
MsgBox "k is now equal to " & k
Next k
Next j
To sum up
Your code should look something like this:
Dim ranges(1 To 14) '<-- not sure, please check it first!
Dim j As Integer, k As Long
ranges(1) = "5-16"
ranges(2) = "21-33"
'....
ranges(14) = "191-203"
For j = 1 To 14
For k = Split(ranges(j),"-")(0) To Split(ranges(j),"-")(1)
Sheet68.Range("G" & k) = Sheet68.Range("D" & k).Value
Next k
Next j

You can just declare 1 int and use it for every loop. U give it a new value at the start of the loop anyway!
So:
Dim z As Integer
For z = 0 To 10 Step 1
//Do something
Next
For z = 11 To 21 Step 1
//Do something
Next

Sub YesButton_Click()
Dim rngTemp As Range
For Each rngTemp In Range("H5:H16, H21:H33, H38:H51, H73:H86, H191:H203")
rngTemp.Value = rngTemp.Offset(, -4).Value
Next rngTemp
For Each rngTemp In Range("G92:G94, G100:G110, G115:G126, G131:G142, G149:G151, G157:G164, G169:G175, G180:G186")
rngTemp.Value = rngTemp.Offset(, -3).Value
Next rngTemp
End Sub

Related

How to assign an array's values to a range?

I'm trying to assign a 1-dimensional array's values to cell range.
For example; my array has 23 items (every item randomized from 1 to 5) and my cell range is range A1 to I7.
I want to assign every value of my array to this cell range randomly.
I randomize the cell values with my array but my array's values are not completely assigned to cells.
Sub define_ore_body()
Dim lb_grade As Integer, ub_grade As Integer
Dim ore_body(1 To 23) As Variant
Dim i As Integer, j As Integer, k As Integer
Dim a As Object
Dim b As Range
Application.ScreenUpdating = False
'my selected range area A1toI7
Set b = Application.Range("A1:I7")
Set a = Application.Cells
'******* low and high ore bound ******
lb_grade = InputBox("Enter lowest ore grade:")
ub_grade = InputBox("Enter highest ore grade:")
'The reason why I do it as follows is that if the random lower bound does not start from 1,
'the largest random number it generates is 2 more than the value I have entered, so
If lb_grade > 1 Then
ub_grade = ub_grade - 2
End If
'******* Random Array ******
'array has 23 items
For i = 1 To 23
ore_body(i) = Int((ub_grade * Rnd) + lb_grade)
Next i
'******* filling random cells with my array******
k = 1
For Each a In b
If a.Value = "" And k < 23 Then
b(Int(7 * Rnd + 1), (8 * Rnd + 1)) = ore_body(k)
ElseIf a.Count > 23 And k > 23 Then
Exit For
Else
k = k + 1
End If
Next a
'******* after filling cell now fill empty cells with Zero******
For i = 1 To 7
For j = 1 To 9
If Cells(i, j) = "" Then
Cells(i, j) = 0
Else
End If
Next j
Next i
'******* Coloring only containing array values******
For i = 1 To 7
For j = 1 To 9
If Cells(i, j) > 0 Then
Application.Cells(i, j).Interior.ColorIndex = 38
Else
End If
Next j
Next i
End Sub
The array contains 23 items that initialize to Variant/Empty:
Dim ore_body(1 To 23) As Variant
Make that 63 items that initialize to 0:
Dim ore_body(1 To 63) As Long
The rest of the code will now populate the first 23 elements, because that's what the loop does:
For i = 1 To 23
If you want the loop to run through all indexes, consider using LBound and UBound operators to programmatically retrieve the lower and upper boundaries of the array, respectively:
For i = LBound(ore_body) To UBound(ore_body)
Note that you have 23 hard-coded in several places, which is going to make it harder than necessary to modify if/when that 23 needs to be come a 25. Consider replacing every occurrence of it by a Const:
Const ElementCount As Long = 23
Then every instance of 23 can become ElementCount, and then when it needs to become 25 then there's only one place that needs any code to change.
Loop through the array.
Set a to a random cell in the range A1:I7.
If cell is empty put the value from the array in the cell, if it
isn't repeat step 2
Sub define_ore_body()
Dim lb_grade As Integer, ub_grade As Integer
Dim ore_body(1 To 23) As Variant
Dim i As Long, j As Long, k As Long
Dim a As Range
Dim b As Range
Application.ScreenUpdating = False
'my selected range area A1:I7
Set b = Application.Range("A1:I7")
' clear A1:A17
b.Clear
'******* low and high ore bound ******
lb_grade = InputBox("Enter lowest ore grade:")
ub_grade = InputBox("Enter highest ore grade:")
'The reason why I do it as follows is that if the random lower bound does not start from 1,
'the largest random number it generates is 2 more than the value I have entered, so
If lb_grade > 1 Then
ub_grade = ub_grade - 2
End If
'******* Random Array ******
'array has 23 items
For i = 1 To 23
ore_body(i) = Int((ub_grade * Rnd) + lb_grade)
Next i
'******* filling random cells with my array******
For k = 1 To 23
Do
Set a = b.Cells(Int(7 * Rnd) + 1, Int(9 * Rnd) + 1)
Loop Until a.Value = ""
a.Value = ore_body(k)
Next k
'******* after filling cell now fill empty cells with Zero******
For i = 1 To 7
For j = 1 To 9
If Cells(i, j) = "" Then
Cells(i, j) = 0
Else
End If
Next j
Next i
'******* Coloring only containing array values******
For i = 1 To 7
For j = 1 To 9
If Cells(i, j) > 0 Then
Application.Cells(i, j).Interior.ColorIndex = 38
Else
End If
Next j
Next i
End Sub

vba loop through array, store values to arrayi

I have some data, stored in arrays like
Dim arrA, arrB, arrC, arrAi, arrBi
Dim i as integer, x as integer
for i = 1 to 100
if cells(i,1).value = "criteria" then ' just add value to array when it meets some criteria
x = x + 1
arrA(x) = cells(i,1).value
arrB(x) = cells(i,2).value
arrC(x) = cells(i,3).value
end if
next i
redim preserve arrA(1 to x)
redim preserve arrB(1 to x)
redim preserve arrC(1 to x)
And the data looks like
arrA: 26.1 40.2 80.3 26.0 41.3 78.7 25.8 40.8 80.0
arrB: 10 11 10 66 67 64 32 32 33
arrC: 1 2 3 1 2 3 1 2 3
Since the values in arrA 26.1, 26.0, 25.8 (position 1, 4, 7) belong to group 1 (referencing to values in arrC at same position), I would like to store 26.1 26.0 25.8 to arrAi and 10 66 32 to arrBi for subsequent calculations.
How can I loop through the 3 arrays and store values to another array as described above?
Thanks in advance.
Try the next way, please:
Sub handleArraysFromArrays()
'your existing code...
'but you fistly must declare
Dim arrA(1 To 100), arrB(1 To 100), arrC(1 To 100)
'....
'your existing code
'...
Dim k As Long, kk As Long
ReDim arrAi(1 To UBound(arrA))
ReDim arrBi(1 To UBound(arrA))
For i = 1 To UBound(arrC)
If arrC(i, 1) = 1 Then k = k + 1: arrAi(k, 1) = arrA(i, 1)
If arrC(i, 1) = 2 Then kk = kk + 1: arrBi(kk, 1) = arrA(i, 1)
Next i
ReDim Preserve arrAi(1 To k): ReDim Preserve arrBi(1 To kk)
Debug.Print UBound(arrAi), UBound(arrBi)
End Sub

Resorting Arrays

I receive data that I need to output in a string of the format:
123 - A, B, C
234 - A
345 - B
567 - B, C
789 - C
The data I get is sorted by letter (A, B, or C) and then given to me by number. So I have three dynamic arrays like:
ArrayA(1) = 123
ArrayA(2) = 234
ArrayB(1) = 345
ArrayB(2) = 123
ArrayB(3) = 567
ArrayC(1) = 123
ArrayC(2) = 789
ArrayC(3) = 567
Notice that the index corresponding to a particular 3-digit number in a given array does not necessarily correspond to the same 3-digit number, e.g. ArrayA(1)=123=ArrayB(2).
The arrays are of arbitrary length (there could be any number of numbers in A, B, or C) but there are only three arrays.
This makes it easy to output something such as:
123 - A
234 - A
345 - B
123 - B
567 - B
123 - C
789 - C
567 - C
but this is NOT my desired result.
I need it in this format:
123 - A, B, C
234 - A
345 - B
567 - B, C
789 - C
To play with this problem directly, here's some code that generates the "easy" string:
Dim ArrayA(2), ArrayB(3), ArrayC(3) As Integer, Output As String
ArrayA(1) = 123
ArrayA(2) = 234
ArrayB(1) = 345
ArrayB(2) = 123
ArrayB(3) = 567
ArrayC(1) = 123
ArrayC(2) = 789
ArrayC(3) = 567
For i=1 to 2
Output = Output & ArrayA(i) & " - A" & vbNewLine
Next i
For i=1 to 3
Output = Output & ArrayB(i) & " - B" & vbNewLine
Next i
For i=1 to 3
Output = Output & ArrayC(i) & " - C" & vbNewLine
Next i
MsgBox(Output)
As mentioned above, I'm hoping to move the format such that it is organized by three-digit number, rather than by letter.
My best attempt at a solution would be to try to write the data into an excel sheet, sort it appropriately, and pull it back into VBA, which seems unnecessarily ugly. For example:
For i=1 to Len(ArrayA)+Len(ArrayB)+Len(ArrayC)
If i < Len(ArrayA) Then
Range("A:"&i).Value = ArrayA(i)
Range("B:"&i).Value = "A,"
End If
If i > Len(ArrayA) And i <= Len(ArrayA) + Len(ArrayB) Then
Range("A:"&i).Value = ArrayB(i)
Range("B:"&i).Value = Range("B:"&i).Value & "B,"
End If
if i >= Len(ArrayA)+Len(ArrayB) Then
Range("A:"&i).Value = ArrayC(i)
Range("B:"&i).Value = Range("B:"&i).Value & "C,"
Next i
Then I could sort this, search out duplicates, and properly combine them, and finally get to the correct output of:
123 - A, B, C
234 - A
345 - B
567 - B, C
789 - C
Try the following:
Sub PopulateFromArrays()
Call WriteArray(ArrayA, "A")
Call WriteArray(ArrayB, "B")
Call WriteArray(ArrayC, "C")
End Sub
Function WriteArray(MyArray, MyString)
i = 2
For j = LBound(MyArray) To UBound(MyArray)
ValueFound = False
k = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To k
If Range("A" & i).Value = MyArray(j) Then
Range("B" & i).Value = Range("B" & i).Value & ", " & MyString
ValueFound = True
Exit For
End If
Next i
If ValueFound = False Then
Range("A" & k + 1).Value = MyArray(j)
Range("B" & k + 1).Value = MyString
End If
Next j
End Function
FYI for testing I populated the arrays with the following:
ArrayA = Array(123, 456, 789)
ArrayB = Array(123, 567, 912)
ArrayC = Array(456, 789, 567)
And the result was:
Seems like a good use case for dictionaries:
ArrayA(1) = 123
ArrayA(2) = 234
ArrayB(1) = 345
ArrayB(2) = 123
ArrayB(3) = 567
ArrayC(1) = 123
ArrayC(2) = 789
ArrayC(3) = 567
'...
Dim e, dictArrays, dictOut, k
Set dictArrays = Createobject("scripting.dictionary")
Set dictOut = Createobject("scripting.dictionary")
dictArrays.Add "A", ArrayA
dictArrays.Add "B", ArrayB
dictArrays.Add "C", ArrayC
For Each k in dictArrays.Keys
For Each e in dictArrays(k)
If dictOut.Exists(e) then
dictOut(e) = dictOut(e) & "," & k
Else
dictOut.Add e, k
End If
Next e
Next k
'output the result
For Each k in dictOut.Keys
Debug.Print k, dictOut(k)
Next k

Type Mismatch VBA array

I keep getting a type mismatch error when I try to run my code. I'm trying to store number in an array and then calculate their sum.
Sub Exercise()
Dim Sum As Integer
Dim A(1 to 5) As Integer
A(1) = 35
A(2) = 71
A(3) = 42
A(4) = 53
A(5) = 109
Sum = 0
Sum = (Sum + A)
For A = 1 To 5
Next Sum
MsgBox Sum
End Sub
I believe you meant to do this:
Sub Exercise()
Dim Sum As Integer
Dim i As Integer
Dim A(1 To 5) As Integer
A(1) = 35
A(2) = 71
A(3) = 42
A(4) = 53
A(5) = 109
Sum = 0
For i = 1 To 5
Sum = (Sum + A(i))
Next i
MsgBox Sum
End Sub
Notice the differences. You set Sum = 0 prior to the loop, then use an iteration variable i to loop through the values of A by calling them using A(i). This adds each A(i) to the running total defined by Sum.
You can't use A as your loop counter, it's your array.
You probably intend to do this:
Dim i As Integer
For i = 1 To 5
Sum = Sum + A(i)
Next
Note that Sum is already initialized to 0, so this line is superfluous:
Sum = 0
And the line that tries to assign Sum = (Sum + A) can just be removed, you can't add an Integer with an array.

Input/output values into an array

EDIT: Updated question using some of the suggestions below. This produces weird output though.
Dim ProviderArray() As Variant
Sub GetProviderNumbers()
Dim InputRange As Range
Dim WorkRange As Range
Set InputRange = Range("ProviderList")
Set WorkRange = Application.Intersect(InputRange, ActiveSheet.UsedRange)
SizeOfArray = Application.WorksheetFunction.CountA(WorkRange)
ReDim ProviderArray(0 To SizeOfArray)
ProviderArray = WorkRange.Value
For r = 1 To UBound(ProviderArray, 1)
For C = 1 To UBound(ProviderArray, 2)
Debug.Print r, C, ProviderArray(r, C)
Next C
Next r
End Sub
1 1 5555
2 1 4444654
3 1 654654
4 1 654654654
5 1
6 1
7 1
8 1
9 1
10 1
11 1
12 1
13 1
14 1
15 1
16 1
17 1
18 1
19 1
Could someone explain why this output?
You can only use the one-line approach if you put the range into a 2-D array: you only have a 1-D array.
You could do this:
Dim ProviderArray()
Set WorkRange = .Intersect(InputRange, ActiveSheet.UsedRange)
'This makes ProviderArray a 2-D array, dimension 1 = # rows,
' dimension2 = #cols. Both dimensions are 1-based.
ProviderArray = WorkRange.value
for r=1 to ubound(ProviderArray,1)
for c=1 to ubound(ProviderArray,2)
debug.print r,c,ProviderArray(r,c)
next c
next r
Maybe something a bit simpler like:
Private Sub GetProviderNumbers()
Dim InputRange() As Variant
InputRange = Range("ProviderList")
For Each i In InputRange
Debug.Print i
Next
End Sub
This captures a two-dimensional range and stores the values in a global two-dimensional array:
Dim ProviderArray() As String
Sub MAIN()
Range("B2:C11").Name = "ProviderList"
Call GetProviderNumbers
End Sub
Sub GetProviderNumbers()
ary = Range("Providerlist")
ll = LBound(ary, 1)
lm = LBound(ary, 2)
ul = UBound(ary, 1)
um = UBound(ary, 2)
ReDim ProviderArray(ll To ul, lm To um)
For i = ll To ul
For j = lm To um
ProviderArray(i, j) = ary(i, j)
Next
Next
End Sub

Resources