Trying to store user values into an array - excel

I am trying to create an array of a user set length that users can add values to that will be saved and output on multiple sheets. I am very new to VBA so I do not know if what I am trying to do is possible but I have tried a few methods unsuccessfully.
This is the code I have so far
Sub addCost()
Dim costArray() As Variant
ReDim Preserve costArray(1 To Range("b2").Value)
For i = 1 To Range("b2").Value
costArray(i) = 0
Next i
Dim newCost As Variant
Dim costYear As Variant
newCost = InputBox("New cost amount:")
costYear = InputBox("Year new cost is active:")
costArray(costYear) = newCost
End Sub
Here is what the input tab looks like in excel
With the length of the array being the project lifespan and the add new cost activating the code, clear costs are still in progress. Is there a way for the array to store after multiple executions of the addCost sub?
Thanks!

This link Microsoft shows some methods of store values after the macro ending (in your case, sub addCost)
I think the first solution will be good for you.
Other solutions is use Access to store data (specially if you need these data over time) or a new and clean worksheet where you can store array entries in a cell (This is a very practical solution if the number of entries does not get too big)

Related

How Can I Re-Write this VBA Macro to be More Efficient? (Copy-Paste Range)

I currently have a full code written to copy the output of one spreadsheet, into certain columns of another spreadsheet. This is part of a project at work, but the VBA codes left to me from an employee that resigned, don't apply well. It's pretty simple in theory.
What I want it to do is pull the value in BB183 from the tab 737-10_1b28_routes in the file 737-10_1b28_routes.csv, and paste it in the tab 737-10 Scenario 1 of file Aero Sales Support Modified Att.1 Performance Data Attachment and Fill in Form_20220402.xlsx in box L30.
I then want the code to take BB184, and place it in L32. I need the code to skip a line because I want to paste different data in the other line (BB697 goes into to L31 with the same repeating pattern for BB (+1) and L (+2). I think once I have a more efficient code, I could figure out the final solution, but need some help. I'm currently running into procedure too large.
I feel like it's j=j+2 from j=30:688 for the L column and BB is like i=i+1 from i=183:512.
Then the second part of the code is j=j+2 from j=31:689 for the L column and BB is like i=i+1 from i=697:1026.
Please see code two to see how it's altered.
Sub vba_copy_data_GCD()
Workbooks("737-10_1b28_routes.csv").Worksheets("737-10_1b28_routes").Range("BB183").Copy _
Workbooks("Aero Sales Support Modified Att.1 Performance Data Attachment and Fill in Form_20220402.xlsx").Worksheets("737-10 Scenario 1").Range("L30")
Workbooks("737-10_1b28_routes.csv").Worksheets("737-10_1b28_routes").Range("BB184").Copy _
Workbooks("Aero Sales Support Modified Att.1 Performance Data Attachment and Fill in Form_20220402.xlsx").Worksheets("737-10 Scenario 1").Range("L32")
Workbooks("737-10_1b28_routes.csv").Worksheets("737-10_1b28_routes").Range("BB185").Copy _
Workbooks("Aero Sales Support Modified Att.1 Performance Data Attachment and Fill in Form_20220402.xlsx").Worksheets("737-10 Scenario 1").Range("L34")
Workbooks("737-10_1b28_routes.csv").Worksheets("737-10_1b28_routes").Range("BB186").Copy _
Workbooks("Aero Sales Support Modified Att.1 Performance Data Attachment and Fill in Form_20220402.xlsx").Worksheets("737-10 Scenario 1").Range("L36")
Workbooks("737-10_1b28_routes.csv").Worksheets("737-10_1b28_routes").Range("BB697").Copy _
Workbooks("Aero Sales Support Modified Att.1 Performance Data Attachment and Fill in Form_20220402.xlsx").Worksheets("737-10 Scenario 1").Range("L31")
Workbooks("737-10_1b28_routes.csv").Worksheets("737-10_1b28_routes").Range("BB698").Copy _
Workbooks("Aero Sales Support Modified Att.1 Performance Data Attachment and Fill in Form_20220402.xlsx").Worksheets("737-10 Scenario 1").Range("L33")
Workbooks("737-10_1b28_routes.csv").Worksheets("737-10_1b28_routes").Range("BB699").Copy _Workbooks("Aero Sales Support Modified Att.1 Performance Data Attachment and Fill in Form_20220402.xlsx").Worksheets("737-10 Scenario 1").Range("L35")
End Sub
Inspecting cell values from VBA is slow. Writing or copying values to cells from VBA is slower still. Doing these things over and over in a loop is a quick way to destroy VBA execution speed.
It is hundreds to thousands of times faster in execution speed to grab a large range and assign the values to a VBA array in one go, and then do the processing directly on the VBA array without touching any of the cells during the processing and then when done, write the entire array out to a worksheet in one go. The larger the ranges involved the greater the execution speed improvement by processing the VBA array instead of the cells directly.
Array processing is extremely fast in VBA. Worksheet cell access is extremely slow from VBA. It takes roughly the same amount of time to write a value to one cell as it does to write tens of thousands of values to a range from a VBA array. Never write individual cell values in a loop!
Using .Offset is also slow and doing so repeatedly is ill advised. This problem is avoided completely by using the array approach.
The following routine should do the trick if I understand your range descriptions adequately. vSrc and vDst are 2D VBA arrays. All the values are processed in the arrays (not on the sheets) and then when done the array values are written to the destination worksheet in one go...
Sub vba_copy_data_GCD()
Dim c&, i&, vSrc, vDst
Const SRC_GAP& = 514
Const SRC_RANGE$ = "bb183:bb1026"
Const SRC_SHEET$ = "737-10_1b28_routes"
Const SRC_WORKB$ = "737-10_1b28_routes.csv"
Const DST_RANGE$ = "l30:l688"
Const DST_SHEET$ = "737-10 Scenario 1"
Const DST_WORKB$ = "Aero Sales Support Modified Att.1 Performance Data Attachment and Fill in Form_20220402.xlsx"
vSrc = Workbooks(SRC_WORKB).Worksheets(SRC_SHEET).Range(SRC_RANGE).Value2
With Workbooks(DST_WORKB).Worksheets(DST_SHEET).Range(DST_RANGE)
vDst = .Value2
For i = 1 To UBound(vDst) \ 2 Step 2
c = c + 1
vDst(i + 0, 1) = vSrc(c, 1)
vDst(i + 1, 1) = vSrc(c + SRC_GAP, 1)
Next
.Value2 = vDst
End With
End Sub
Given how sure I am of what you want, please make sure your files are backed-up before trying this:
Sub vba_copy_data_GCD()
Dim srcWS as Worksheet
Dim destWS as Worksheet
Dim i as Long, j as Long
Set srcWS = Workbooks("737-10_1b28_routes.csv").Worksheets("737-10_1b28_routes")
Set destWS = Workbooks("Aero Sales Support Modified Att.1 Performance Data Attachment and Fill in Form_20220402.xlsx").Worksheets("737-10 Scenario 1")
For i = 0 to 329 Step 2
With destWS
.Range("L30").Offset(i,0).Value2 = srcWS.Range("BB183").Offset(j,0).Value2
.Range("L31").Offset(i,0).Value2 = srcWS.Range("BB697").Offset(j,0).Value2
End With
j = j + 1
Next i
End Sub

Dynamic multiple Autofilter Criteria for Excel using VBA

We have a tracking list with product IDs in Excel and we frequently have to compare entries for several products using this tracking list. We use the .AutoFilter, search for the ID then click on "add to current selection". We repeat that N times. I want to automate this using VBA.
I have constructed an Input collector and as far as I can understand I need to collect the data in an Array.
Here a screenshot of a test worksheet.
And here a test code that is gets an array and plugs it into .AutoFilter with 'xlFilterValues' this does yield not the desired outcome but rather and empty list.
Sub Multifilter()
Dim FilteredRNG As Range
Dim TestAR(4) As Long
TestAR(0) = 100034
TestAR(1) = 165738
TestAR(2) = 165510
TestAR(3) = 165512
TestAR(4) = 165567
Set FilteredRNG = Sheet2.Range("B1:B29") ' Get my test range
FilteredRNG.AutoFilter Field:=1, Criteria1:=TestAR, Operator:=xlFilterValues
End Sub
Result is here:
If I switch the Operator to xlOr the Result changes to:
My Array looks good during debugging:
So how do I get N IDs selected from the ID list using an array?
I figured it out. The array needs to be a string in order for it to work.
Dim TestAR(4) As String
Solves the issue.

Excel find remaining columns efficiently

I have a script (thanks to SO for the help with that one!) to allow a user to select a number of discontinuous columns and insert their indexes into an array. What I need to be able to do now is efficiently select the remaining columns i.e. the ones that the user didn't select into another array to perform a separate action on these columns.
For example, the user selects columns A,C,F,G and these indexes are put into the array Usr_col(). The remaining columns (B,D,E) need to be stored in the array rem_col()
All I can think of right now is to test every used column's index against the array of user-selected columns and, if it is not contained in that array, insert it into a new array. Something like this:
For i = 1 to ws.cells(1, columns.count).end(xltoright).column
if isinarray(i, Usr_col()) = false Then
rem_col(n) = i
n = n+1
end if
next
I am just looking for a more efficient solution to this.
I agree with #ScottHoltzman that this site wouldn't normally be the arena to make working code more efficient. However, this question puts a different slant on your previous one, as the most obvious solution would be to assign column numbers to one or other of your arrays in one loop.
The code below gives you a skeleton example. You'd need to check the user's selection for proper columns. Also, it isn't great form to redimension an array within the loop, but if the user selects adjacent columns then you'd need to acquire area count and column count to get the array size. I'll leave that to you if rediming within the loop jars with you:
Dim targetCols As Range, allCols As Range
Dim selColNum() As Long, unselColNum() As Long
Dim selIndex As Long, unselIndex As Long
Set targetCols = Application.InputBox("Select your columns", Type:=8)
For Each allCols In Sheet1.UsedRange.Columns
If Intersect(allCols, targetCols) Is Nothing Then
ReDim Preserve unselColNum(unselIndex)
unselColNum(unselIndex) = allCols.Column
unselIndex = unselIndex + 1
Else
ReDim Preserve selColNum(selIndex)
selColNum(selIndex) = allCols.Column
selIndex = selIndex + 1
End If
Next

How to merge two (or more) rows using VBA in Excel?

I am trying to merge two rows in Excel using VBA in order to create a new row with the combination values of selected rows using a factor x.
alpha 5 6 8 3 ...
beta 10 1 5 7 ...
With alpha and beta I want to create row ab70 (x=.7)
ab70 6.5 4.5 7.1 4.2 ...
(5*.7+10(1-.7)) ...
I would like to create this from a GUI in VBA selecting from a list the materials and chosing the factor x.
Thanks :D
L
The first version of this answer was more concerned with clarifying the requirement than answering the question. The second version is closer to an proper answer. Questions in the first version which were answered in comments have been deleted.
First version after removal of questions
This is not a site which can teach you to create a userform although you could get help with the code for a control. Try searching the web for “excel vba userform tutorial”. There are a number to choose from. I have not tried any so cannot make a recommendation.
A List box allows the program to provide a list from which the user can select one or more items. A Combo box allows the program to provide a list from which the user can select one item or enter a new value that is not within the list. You do not want the user to be able to specify their own material so you need a List Box. By default the user can only select one item which is what you want.
Second version
This will not be a complete answer. I will give you design ideas which you can then develop to meet your exact requirement or you can clarify your requirement and I will develop them a little more. I will give you some useful code but not all you will need for the complete solution.
You say that combining two materials would meet your immediate needs but in the longer term you wish to combine more. There are different approaches to addressing such a situation:
Design and implement a solution for the immediate need now. Redesign for the longer term later.
Design and implement a solution for the long term need now.
Design a solution for the long term then implement as much of the long-term design as seems appropriate.
None of these approaches will be correct in every case. If you are working to a deadline, approach 1 many be the only choice. Approach 1 may also be appropriate if you lack experience with the technology and wish for a simple implementation as a training exercise. When I was young, distributing a new version of an application to multiple users could be very expensive and approach 2 would often be the preferred approach. These days, approach 3 is normally my preference.
From your comments I deduce you are thinking of something like:
The two list boxes are filled with the names of the materials so the user can click one row in the first list box and one in the second to specify the two materials. Text boxes allow the user to enter the Proportion and the Name. I have used the blue “Rem” to represent the remainder (1 – x) which you may wish to display as a comment. You may not have thought of buttons. There should always be an Exit button in case the user has started the macro unintentionally. Clicking a button to save the mixture allows the user to check the four values first.
I think this could be an excellent design for the two material version. If we ignore the actual merging of the rows, there would be little code behind this form.
I do not know how long your material names are but I assume this design could be expanded for three or four materials by adding extra list boxes to the right with a Proportion text box under all but the last list. However, this arrangement would have a low maximum number of materials in a mixture. This will be acceptable if you do have a low maximum. You might also allow the user to mix mixtures thereby allowing an unlimited number of base materials in a mixture.
The code behind a form that allowed three or four materials in a mixture would be only a little more complicated than that behind the two material version.
I have two alternative designs that would perhaps be better with a higher maximum number of materials but it will not outline then unless you indicates that this first design is unacceptable.
I would expect any good tutorial to explain the various methods of loading a list box with values to I will not repeat them.
However you decide to handle the selection of materials and their proportions, you will need a routine to generate the new row.
I have created a worksheet “Material” and have set the first few rows and columns so:
I appreciate you have many more rows and columns but my data is adequate for a test and demonstration. Note in the heading line "Prop" is short for "Property".
You need to tell the routine which merges rows, which rows to mix. The user will select material B2 say. You could pass “B2” to the routine and let it discover the row from which it had come but this would make the routine more difficult to code than necessary. When loading the list boxes from this worksheet, values will be taken from column A of rows 2 to 12. I would expect your user form tutorial to explain that your code can identify the value selected by the user either by value (B2) or by index (4th row). You know the 1st row of the list box was loaded from row 2 of the worksheet so you can calculate that the 4th row of the list box was loaded from row 5 of the worksheet.
You need to tells the routine the proportions entered by the user and the name of the mixture.
Above I listed three possible approaches to deciding how much to implement. An addition to any of these approaches is the inclusion of flexibility that is not required but is as easy or is easier to include than exclude.
The declaration for my routine is:
Sub RecordNewMixture(ByVal WshtName, ByRef RowSrc() As Long, ByRef Prop() As Single, _
ByVal MaterialNameNew As String)
You will only have one worksheet holding materials and its name is unlikely to change so I could hardcode that worksheet’s name into the routine. However, it almost as easy to make the worksheet name a parameter and I think it makes the code tidier so I have make it a parameter.
The routine requires the array Prop() hold all the proportions including the last. So, for example, (0.7, 0.3) or (0.3, 0.3, 0.4). The user form will have to calculate the last proportion so it might as well pass the last proportion. I have made Prop() an array of Singles which I assume will give you adequate precision. If you do not understand the last sentence I can explain. Note that here "Prop" is short for proportion. Sorry for using "Prop" as an abbreviation for both "Property" and "Proportion". I did not notice until I the final checking of this text.
I needed a routine to test Sub RecordNewMixture so I have provided it as a demonstration. Note that I have coded and tested this routine without any involvement of the user form. It is always a good idea to develop and test your routines in isolation before combining them into the finished product.
After running the macro, worksheet “Material” has two new rows:
If you duplicate the new rows with formulae, you will find that the values are as you require.
Option Explicit
Sub Test()
Dim RowSrc() As Long
Dim Prop() As Single
ReDim RowSrc(0 To 1)
ReDim Prop(0 To 1)
RowSrc(0) = 2: Prop(0) = 0.7!
RowSrc(1) = 4: Prop(1) = 0.3!
Call RecordNewMixture("Material", RowSrc, Prop, "Join24")
ReDim RowSrc(1 To 3)
ReDim Prop(1 To 3)
RowSrc(1) = 3: Prop(1) = 0.3!
RowSrc(2) = 6: Prop(2) = 0.3!
RowSrc(3) = 9: Prop(3) = 0.4!
Call RecordNewMixture("Material", RowSrc, Prop, "Join369")
End Sub
Sub RecordNewMixture(ByVal WshtName, ByRef RowSrc() As Long, ByRef Prop() As Single, _
ByVal MaterialNameNew As String)
' * RowSrc is an array containing the numbers of the rows in worksheet WshtName
' that are to be mixed to create a new material.
' * Prop is an array containing the proportions of each source material in the new
' mixture.
' * Arrays RowSrc and Prop must have the same lower and upper bounds.
' * MaterialNameNew is the name of the mixture.
' * Each data row in Worksheet WshtName defines a material. Column A contains the
' name of the material. The remaining columns contain numeric properties of the
' material.
' Each data row in Worksheet WshtName must have the same maximum number of
' columns. Call this value ColLast.
' * This routine creates a new row below any existing rows within worksheet
' WshtName. Call this row RowNew. The values in this new row are:
' * Column A = MaterialNameNew
' * For ColCrnt = 2 to ColMax
' * Cell(RowNew, ColCrnt) = Sum of Cell(RowSrc(N), ColCrnt) * Prop(N)
' for N = LBound(RowSrc) to UBound(RowSrc)
Dim ColCrnt As Long
Dim ColLast As Long
Dim InxRowSrc As Long
Dim RowNew As Long
Dim ValueNewCrnt As Single
Application.ScreenUpdating = False
With Worksheets(WshtName)
' Locate the row before the last row with a value in column A
RowNew = .Cells(Rows.Count, "A").End(xlUp).Row + 1
' Store name of new material
.Cells(RowNew, "A") = MaterialNameNew
' Locate the last column in the first source row. Assume same
' last column for all other source rows
ColLast = .Cells(RowSrc(LBound(RowSrc)), Columns.Count).End(xlToLeft).Column
For ColCrnt = 2 To ColLast
' If Single does not give adequate precision, change the declaration of
' Prop() and ValueNewCrnt to Double. If you do this, replace "0!" by "0#"
ValueNewCrnt = 0!
For InxRowSrc = LBound(RowSrc) To UBound(RowSrc)
ValueNewCrnt = ValueNewCrnt + .Cells(RowSrc(InxRowSrc), ColCrnt).Value * Prop(InxRowSrc)
Next
.Cells(RowNew, ColCrnt) = ValueNewCrnt
Next
End With
Application.ScreenUpdating = True
End Sub

Having trouble populating a variable range

I have dabbled in vba for a little while, but its uses are mainly to save myself work and make easy things that are not easy to do in vanilla excel. I use SQL a lot and many things that are fascinatingly easy to get in SQL are surprisingly difficult in excel.
I recently made a new file to follow the costs that are generated when someone takes an item from our warehouse. Assuming that everything gets registered correctly I have made an SQL report that spits out different data; among which are pertinent to this question:
An article number
A cost centre
Now, I thought I would improve my file with some autogenerated lists, so I can use it for whatever department not just my own. The difference is that I know roughly the correct article numbers and cost centers of my department.
What I would like to do.
With a list of cost center numbers:
Generate a list of article numbers that are taken from the dump (~10.000 rows) that have been listed on each (specific) cost center. Unique, of course
Use the count of cost centers and the count of article numbers to copy formulas from a sheet with a template...
...then populate the fresh sheet with the cost centers and article numbers. The formulas will then fetch with sumifs from the dump and make nice monthly graphics of it all.
This is getting out of hand with the explanation, because I stranded pretty early doing this:
'-----------------------------------------------
Dim Myworkbook As Workbook
Set Myworkbook = ThisWorkbook
'-
Dim Sheet1 As Worksheet
Dim Sheet2 As Worksheet
Dim Sheet3 As Worksheet
Dim Rgensheet As Worksheet
'-
Set Sheet1 = Myworkbook.Sheets("Sheet1")
Set Sheet2 = Myworkbook.Sheets("00 Underlag")
Set Sheet3 = Myworkbook.Sheets("01 Dump")
Set Rgensheet = Myworkbook.Sheets("RGenInput")
'-
Dim Dump As Range
Set Dump = Sheet3.Range("A:M")
'------------------------------------------------
Dim antkat As Long
antkat = WorksheetFunction.Count(Rgensheet.Range("C:C"))
Dim kat As Range
Set kat = Myworkbook.Sheets("RGenInput").Range("C1:C" & antkat)
Dim kst As Long
kst = 242020
'To make matters easy I try to get the macro work for a single cost centre first...
'I plan to have a For-loop around that covers all of them, with the antkat variable
Dim artnos As Range
Dim artno As Long
Dim n As Integer
n = 1
For Each Row In Dump.Rows
If IsNumeric(Sheet3.Range("M" & Row.Row)) Then
If Sheet3.Range("M" & Row.Row) = kst Then
artno = Cells(Row.Row, 6)
On Error Resume Next
If IsError(Application.Match(artno, artnos, False)) Then
' I used the same code once to create a list of unique values from a huge list but I am unsure wether I can do this to a range that has no dimensions...
Set artnos.Range(1, n).Value = artno
n = n + 1
End If
End If
End If
Next Row
Now - this is ugly and very not up to my code standard but it has been a bigger project than what I normally do.
The question is twofold.
Is it possible to define a range variable that is completely flexible as to dimensions? This is what I am used to, you can just add rows to a variable table in sql like nothing but I am starting to think this is not possible the way I am trying to do it
Is this a reasonable way to execute the plan I made beforehand? If my code is to messy to read or the errors I make too many - can you please help me find a plan of execution or steps that can perform what I need? I can - with the help of google - figure out how to do the steps. That has worked for me in the past... =P
I found the answer, by chance, browsing through some microsoft help files. Who would have thought.
I was mistaken in thinking that a variable range can be used as the array. For future users having issues giving a variable several values - do read up on arrays which are defined by adding closed parentheses to your variable
Dim variable as integer
Dim variablearray() as integer

Resources