I am a totally newbie in Vba and need to solve a specific problem with a macro and vba. I hope, you can help me with this problem!
I try to built a macro which should help me with this steps:
I use a "cockpit-file" with which I want to substract all cells from two worksheets with eachother. I get the worksheets from two different workbooks. ;-) As an example: I want to subtract the cell F11 (Workbook1.Worksheet1) from F11 (Workbook2.Worksheet1), than F12 (workboosk1.worksheet1) from F12 (Workbook2.Worksheet1), [...] J34 (Wb1.ws1.) from J34(Wb2.ws.1)
I want to change and select the files. Therefore I need window in which one I can select the specific files.
To avoid errors the math should be done via Arrays in vba. And the new Value should be added in one of the workbooks
I tried to use a Loop to solve the problem with the math but it doesn't work. When I come to the subtractionformula I get the runtime error 13.
Hope you can help me! Sorry for my bad english
Thats my code
Sub Makro4()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'Variabledef
Dim i As Long 'Index
Dim j As Long 'Index
Dim k As Long 'Index
Dim ArrayA As Variant 'Array
Dim ArrayB As Variant 'Array
Dim ArrayC As Variant 'Array
Dim MyFile1 As String 'Workbookname
Dim MyFile2 As String 'Workbookname
Dim wb1 As String 'Workbookname
Dim wb2 As String 'Workbookname
Dim WS_Count1 As Integer 'Count Worksheets
Dim WS_Count2 As Integer 'Count Worksheets
Dim arrays1 As String 'Dimension
Dim arrays2 As String 'Dimension
'Change the actual path
ChDrive "O:\"
ChDir "O:[.......]\VBA"
'Selection first File
MyFile1 = Application.GetOpenFilename
Workbooks.Open Filename:=MyFile1, ReadOnly:=True, IgnoreReadOnlyRecommended:=True
wb1 = ActiveWorkbook.Name
ArrayA = Workbooks(wb1).Worksheets("01").Range("F11:GL46").Value
WS_Count1 = ActiveWorkbook.Worksheets.Count
'Selection second File
MyFile2 = Application.GetOpenFilename
Workbooks.Open Filename:=MyFile2, ReadOnly:=True, IgnoreReadOnlyRecommended:=True
wb2 = ActiveWorkbook.Name
ArrayB = Workbooks(wb2).Worksheets("01").Range("F11:GL46").Value
WS_Count2 = ActiveWorkbook.Worksheets.Count
' Calculation of the math - Runtime Error 13
For k = 1 To WS_Count1
For i = LBound(ArrayA, 1) To UBound(ArrayA, 1)
For j = LBound(ArrayA, 2) To UBound(ArrayA, 2)
ArrayC(i, j) = ArrayA(i, j) - ArrayB(i, j)
Next j
Next i
Worksheets("k").Range("F11:GL34").Value = ArrayC
Next k
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
ArrayC is not initialized yet. It's defined as Variant, which means, the type is unknown until something gets assigned to the variable.
With this line ArrayC(i, j) = ArrayA(i, j) - ArrayB(i, j) you already assume that ArrayC holds an array, which it doesn't yet.
First define ArrayC in your head like this Dim ArrayC(). this way it's clearly defined as an array. Still without size though.
Now before the line For k = 1 To WS_Count1, you set the dimension of your array this way ReDim ArrayC(UBound(ArrayA,1) ,UBound(ArrayA,2)) This should create an 2D array with the same size as ArrayA.
Now you have a fully initialized array
Now your program should work.
Related
I have the following problem: I imported a .csv file with my data into a separate worksheet called "Import".
In this QueryTable, I have the second column called "KW", which indicates the weeknumber for every row.
Now I wanted to populate an array with the cell values from the second column.
I need to make it dynamic, because the length of the array changes with each import.
So far I made the code below:
Sub PopulatingArrayVariable()
Dim myArray() As Variant
Dim TempArray() As Variant
Dim myTable As ListObject
Dim x As Long
Sheets("Import").Activate
Set myTable = ActiveSheet.ListObjects("database_all")
TempArray = myTable.DataBodyRange.Columns(2)
myArray = Application.Transpose(TempArray)
For x = LBound(myArray) To UBound(myArray)
Debug.Print myArray(x)
Next x
End Sub
I get the "runtime error 13": types not compatible
I get the error, but I don't know what exactly I need to change. Can someone please help me solve this?
Fix the Dim and use Set:
Sub PopulatingArrayVariable()
Dim myArray() As Variant '*** will be a 1D VBA array
Dim TempArray As Range '*** typical 2D range variable as part of a column
Dim myTable As ListObject
Dim x As Long
Sheets("Import").Activate
Set myTable = ActiveSheet.ListObjects("database_all")
Set TempArray = myTable.DataBodyRange.Columns(2)
myArray = Application.Transpose(TempArray)
For x = LBound(myArray) To UBound(myArray)
Debug.Print myArray(x)
Next x
End Sub
I would use an arraylist instead as it provides more flexibility. For example you can do something like this:
Sub test()
Dim arr As Object
Dim i As Long
Dim j As Long
Dim lastRow As Long
Set arr = CreateObject("System.Collections.ArrayList")
lastRow = Cells(Rows.Count, 2).End(xlUp).Row
j = 2
'Filling arrayLists
For i = 2 To lastRow
arr.Add ActiveSheet.Cells(i, 2)
Next i
'Read from arrayLists
For i = 0 To arr.Count - 1
Cells(j, 3) = arr(i)
j = j + 1
Next i
End Sub
Customize the code as required. It should resolve your issue.
my code copies all the values of a table in excel on an array an filter them and fill a combobox with it, but I keep geting this error on my code and after debuging it's seems that the error is due to Redim Preserve ... can you check it please ?
' FIll CB2()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("D1")
Dim LC As Long
Dim i As Long
Dim PN As Long
Dim myArray() As String
Dim j As Long
Dim k As Long
Dim temp As String
LC = ws.Cells(ws.Rows.Count, 4).End(xlUp).Row
For i = 1 To LC
If StrComp(CB1.List(CB1.ListIndex, 0), ws.Cells(i, 4), vbTextCompare) = 0 Then
'Set you array with the right dimension
ReDim Preserve myArray(0 To PN, 0 To 1)
myArray(PN, 0) = ws.Cells(i, 2)
myArray(PN, 1) = ws.Cells(i, 3)
PN = PN + 1
End If
Next i
End Sub
There is nothing to "Preserve" when the Redim statement is called for the first time in your loop. Call Redim without "Preserve" when you dimension the array for the first time.
If the line of code that dimensions variables is real code it is surprising that it doesn't call an error. I suggest to place each Dim statement in a line by itself, for better readability of the code if for no other reason, and avoid the use of the colon quite generally but especially for the purpose of mixing declarations with value assignment.
I'm trying to pass data from sheet 3 to sheet 4 based on a criterion (*). With numbers results but with text the program fails.
How to overcome this situation when instead of a number I have text.
Public Sub TestArray3()
'Array to copy data from Sheet3 to Sheet4 Based on criterion "in this case*"
Dim tempVar As Integer, anotherIteration As Boolean, i As Integer
Dim J As Integer, ArraySize As Integer, myArray() As Integer
Dim newArray() As Integer, FinalRow As Integer, linha As Integer
Dim counter As Integer, cel1 As Range
Sheets("Folha3").Select
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row ' Find the last row of data
ArraySize = FinalRow 'Get Array Size
ReDim myArray(ArraySize - 1)
For linha = 1 To FinalRow
Set cel1 = Cells(linha, 1)
If cel1 = "*" Then
myArray(linha - 1) = Val(Cells(linha, "B").Value) 'Populate de Array
End If
Next linha
ReDim newArray(LBound(myArray) To UBound(myArray)) 'Avoid zeros in Array
For i = LBound(myArray) To UBound(myArray)
If myArray(i) <> "0" Then
J = J + 1
newArray(J) = myArray(i)
End If
Next i
ReDim Preserve newArray(LBound(myArray) To J)
ArraySize = J
Sheets("Folha4").Select 'Write data to Sheet 4 column A
Range("A1").Resize(J - LBound(newArray) + 1)=Application.Transpose(newArray)
End Sub
I'm not clear on where you're actually trying to paste from/to, but here's one [of several] ways to move data between worksheets, including both with and without transposing
Hopefully this example should clear up the steps:
Sub copyRangeToOtherSheet()
Dim lastRow As Long, lastCol As Long, rgSrc As Range, rgDest As Range, arr() As Variant
With ThisWorkbook.Sheets("Sheet1") 'set source worksheet
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row 'find last row of Col A
lastCol = .Cells(1, Columns.Count).End(xlToLeft).Column 'find last col of Row 1
Set rgSrc = Range(.Range("A1"), .Cells(lastRow, lastCol)) 'create range (from A1)
End With
arr = rgSrc 'dump range into array
With ThisWorkbook.Sheets("Sheet2") 'set destination sheet
'OPTION #1: Populate destination in "original" orientation
Set rgDest = .Range("A1") 'set destination top-left corner
Set rgDest = rgDest.Resize(UBound(arr, 1), UBound(arr, 2)) 'fit to array rows/col's
rgDest = arr 'dump array to worksheet range
'OPTION #2: Populate destination in "transposed" orientation
Set rgDest = .Range("D1") 'set destination top-left corner
Set rgDest = rgDest.Resize(UBound(arr, 2), UBound(arr, 1)) 'fit to array col's/rows
rgDest = WorksheetFunction.Transpose(arr) 'dump transposed array to worksheet range
End With
End Sub
Note that it's easiest if you don't set the size of the array in advance — Excel will size it automatically as long as the array isn't already dimensioned (which is why it's declared only as arr() As Variant).
On the destination end, we can pick one cell as the top-left of the range, then ReSize the range based on the arrays' upper bounds (UBound).
If we are going to Transpose the cells, we must swap the number of rows/columns in the destination range.
More Information:
One resource I've found very helpful is Chip Pearson's VBA Arrays And Worksheet Ranges.
String vs Integer
It is a little unclear what is happening here, but I have noticed that you have declared all your arrays as integer so you cannot pass strings to them. Try to find out which array you're trying to pass strings to and declare it as variant or implement some 'conditional' code like:
If Not IsNumeric(Cells("A1").Value) then
Variable = 0
End If
Read ashleedawg's guidelines.
You don't have to select a worksheet to do stuff to it (referring to Select). You can write
FinalRow = Sheets("Folha3").Cells(Rows.Count, 1).End(xlUp).Row
or
Sheets("Folha4").Range("A1").Resize(J - LBound(newArray) + 1) _
= Application.Transpose(newArray)
and save a line but more importantly, not jump around in the workboook. Even better is using With:
With Sheets("Folha3")
FinalRow = .Cells(Rows.Count, 1).End(xlUp).Row ' Find the last row of data
ArraySize = FinalRow 'Get Array Size
ReDim myArray(ArraySize - 1)
For linha = 1 To FinalRow
Set cel1 = .Cells(linha, 1)
If cel1 = "*" Then
myArray(linha - 1) = Val(.Cells(linha, "B").Value) 'Populate de Array
End If
Next linha
End With
Notice the '.' in front of each cells (.cells), it is referring to the sheet object.
Try using variables for objects. When you write
Sheets("folha3").
nothing happens you have to remember what it can do. But if you assign it to a variable the intelliSense is activated and you can see the properties and methods of objects e.g.
Dim oWb as Workbook
Dim oWs as Worksheet
Set oWb = Activeworkbook
Set oWs = oWb.Sheets("Folha3")
Now when you write:
oWs.
the IntelliSense shows you the properties and methods of the worksheet object e.g. Activate, Cells, Copy, Delete, Paste etc.
With a few more lines of code you will learn much more.
I am trying to use excel 2010 VBA to populate an array containing three arrays. The first is a string type array and the other two are integer type arrays. The relevant portion of the macro is below.
Option Explicit
Option Base 1
Private Type T_small
myStr() As String
y() As Integer
z() As Integer
End Type
Sub ColorByPoint()
On Error GoTo ErrHandler
Dim I As Integer, SCCount As Integer, PCCount As Integer, CLCount As Integer
Dim N As Integer, M As Integer, K As Integer, P As Integer
Dim x() As String, y() As Integer, z() As Integer
Dim pvtItM As Variant
Dim xName As String, str As String
Dim xlRowField As Range
Dim PC As ChartObjects
Dim WS As Sheet3
Dim SC As SeriesCollection
Dim MyObj As Object
Dim PvTbl As Object
Dim CelVal As Integer
Dim rng As Variant, lbl As Variant, vlu As Variant
Dim ItemField1 As PivotItem, ItemField2 As PivotItem
Dim ValueField As PivotField
Dim dField As PivotCell
Dim oPi As PivotItem
Dim acolRng As Range
Dim arowRng As Range
Dim myStr() As String
Dim iData() As T_small
Dim xSSN() As String
Set WS = Application.ActiveWorkbook.ActiveSheet
Set MyObj = Worksheets("Pivot1").ChartObjects("MyChart").Chart
Set PvTbl = Worksheets("Pivot1").PivotTables("PivotTable1")
Set rng = PvTbl.PivotFields("SSN").PivotItems
Set lbl = PvTbl.DataFields
M = 1
SCCount = MyObj.SeriesCollection.Count 'Series count
PCCount = PvTbl.TableRange1.Rows.Count 'Rows Count
CLCount = PvTbl.TableRange1.Columns.Count 'Columns Count
Set acolRng = PvTbl.ColumnRange
Set arowRng = PvTbl.RowRange
Worksheets("Pivot1").Activate
P = PCCount
ReDim Preserve myStr(P)
ReDim Preserve y(P)
ReDim Preserve z(P)
ReDim Preserve iData(P)
For N = 2 To PCCount
ReDim Preserve iData((iData(2).myStr(2)), (iData(N).y(N)),(iData(N).z(N)))
Next N
For I = 2 To PvTbl.TableRange1.Rows.Count Step 1
For K = 2 To PvTbl.TableRange1.Columns.Count Step 1
M = K
N = K
iData(I).myStr(I) = PvTbl.Cells("myStr" & I, "K").Value
iData(I).y(I) = PvTbl.Cells("I", "M").Value
iData(I).z(I) = PvTbl.Cells("I", "N").Value
Next K
Next I
The problem is that the line
ReDim Preserve iData((iData(2).myStr(2)), (iData(N).y(N)), (iData(N).z(N)))
continues to give me a "Run Time error 9 Subscript out of range" error. I've tried everything I can think of to get past this including using "N"'s instead of the "2" indexes throughout, adding and removing parentheses, etc.
What causes the runtime error?
The problem is you are accessing the array indexes of your T_small properties. You never define (or change) the bounds of iData(x).myStr; rather you only define the bounds of myStr, which is not part of your iData array.
In other words, the of bounds error comes from trying to access iData(x).myStr(x) because iData(x).myStr has no bounds defined.
This should work:
' Now that the iData bounds have been defined, update the property bounds.
ReDim Preserve iData(N).myStr(myStr(N))
ReDim Preserve iData(N).y(y(N))
ReDim Preserve iData(N).z(z(N))
Note that I am having a bit of difficulty following exactly what your code is trying to accomplish, so the above only addresses the specific error you are getting.
Using Excel (2010) VBA, I am trying to copy (pass) a constant range of cells (whose values recalculate) to an array. Then I am trying to pass that array to a new range of cells, directly below it. After I have done this, I want to again copy (pass) the constant range's new values to the array, and pass these new values to a range directly below the one I previously passed.
I know this code is atrocious (I am new to arrays in VBA).
Sub ARRAYER()
Dim anARRAY(5) As Variant
Number_of_Sims = 10
For i = 1 To Number_of_Sims
anARRAY = Range("C4:G4")
Range("C4").Select
ActiveCell.Offset(Number_of_Sims, 0).Select
ActiveCell = anARRAY
Range("C4").Select
Next
End Sub
I sure do appreciate your help!
Thank you.
Respectfully,
Jonathan
You are off slightly on a few things here, so hopefully the following helps.
Firstly, you don't need to select ranges to access their properties, you can just specify their address etc. Secondly, unless you are manipulating the values within the range, you don't actually need to set them to a variant. If you do want to manipulate the values, you can leave out the bounds of the array as it will be set when you define the range.
It's also good practice to use Option Explicit at the top of your modules to force variable declaration.
The following will do what you are after:
Sub ARRAYER()
Dim Number_of_Sims As Integer, i As Integer
Number_of_Sims = 10
For i = 1 To Number_of_Sims
'Do your calculation here to update C4 to G4
Range(Cells(4 + i, "C"), Cells(4 + i, "G")).Value = Range("C4:G4").Value
Next
End Sub
If you do want to manipulate the values within the array then do this:
Sub ARRAYER()
Dim Number_of_Sims As Integer, i As Integer
Dim anARRAY as Variant
Number_of_Sims = 10
For i = 1 To Number_of_Sims
'Do your calculation here to update C4 to G4
anARRAY= Range("C4:G4").Value
'You can loop through the array and manipulate it here
Range(Cells(4 + i, "C"), Cells(4 + i, "G")).Value = anARRAY
Next
End Sub
No need for array. Just use something like this:
Sub ARRAYER()
Dim Rng As Range
Dim Number_of_Sims As Long
Dim i As Long
Number_of_Sims = 10
Set Rng = Range("C4:G4")
For i = 1 To Number_of_Sims
Rng.Offset(i, 0).Value = Rng.Value
Worksheets("Sheetname").Calculate 'replacing Sheetname with name of your sheet
Next
End Sub
Since you are copying tha same data to all rows, you don't actually need to loop at all. Try this:
Sub ARRAYER()
Dim Number_of_Sims As Long
Dim rng As Range
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Number_of_Sims = 100000
Set rng = Range("C4:G4")
rng.Offset(1, 0).Resize(Number_of_Sims) = rng.Value
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
When i Tried your Code i got en Error when i wanted to fill the Array.
you can try to fill the Array like This.
Sub Testing_Data()
Dim k As Long, S2 As Worksheet, VArray
Application.ScreenUpdating = False
Set S2 = ThisWorkbook.Sheets("Sheet1")
With S2
VArray = .Range("A1:A" & .Cells(Rows.Count, "A").End(xlUp).Row)
End With
For k = 2 To UBound(VArray, 1)
S2.Cells(k, "B") = VArray(k, 1) / 100
S2.Cells(k, "C") = VArray(k, 1) * S2.Cells(k, "B")
Next
End Sub