Arrays in Excel VBA macro - excel

I have a folder with many files, out of which I need to: open the files for this week, store them in an array, pass them to a sub, and loop through them for getting summary information.
I am able to get the desired day files from the below code. But the code is throwing an error for storing it in the array and passing it to the array.
Sub BatchProcessing()
firstday = Date - Weekday(Date) + 2 'To get the 1st day of week
lastday = Date - Weekday(Date) + 6 'To get the 5th day of week
MyPath = "P:\Data\" 'Path where my files were present
Dim Day
Dim strArray(0 To 5) As String
iCount=0
For Day = firstday To lastday 'To loop through all 5 day files
formatted_date = Format(Day, "yyyyMd")
MyTemplate = "TestFile" & formatted_date & ".xlsx" ' Set the template.
Workbooks.Open MyPath & MyTemplate
strArray(iCount) = ActiveWorkbook.Name
iCount = iCount+1
Next
CreateStats(strArray) 'Calling a sub which will do the required calculation
End Sub
Sub CreateStats(strArray As String)
For Each element in strArray
set OriginalWorkbook = strArray(i)
'Do the processing'
Next
End Sub

Your strArray variable is of type Single. If you want that variable to be a string array, you must declare it as such:
Dim strArray(0 to 5) As String
EDIT:
Now that you've changed your code to use strArray() As String rather than strArray As Single, you should update your CreateStats sub procedure to accept an array as a parameter. It should now look something like this:
Private Sub CreateStats(myArray() As String)
As you have it now, your procedure only accepts a single string. It must accept an array of strings. Once you have that, you can loop through each string and do your processing.

By naming your array strArray it appears that you are going to have an array of strings, and in fact you attempt to store workbook names in it. However, you declared array to be Single, which is a numeric data type. Depending on what your CreateStats(strArray) sub does, you may need to change that from Single to String or possibly set up another array to hold the Single and this one to hold the String.

Related

In VBA, how to extract the string before a number from the text

From ActiveWorkbook.name, I would like to extract the strings that are before (left side of ) the numbers. Since I want to use the same code in multiple workbooks, the file names would be variable, but every file name has date info in the middle (yyyymmdd).
In case of excel file, I can use the below formula, but can I apply the same kind of method in VBA?
=LEFT(A1,MIN(FIND({0,1,2,3,4,5,6,7,8,9},ASC(A1)&1234567890))-1)
Example: MyExcelWorkbook_Management_20200602_MyName.xlsm
In above case, I want to extract "MyExcelWorkbook_Management_".
The most basic thing you could do is to replicate something that worked for you in Excel through Evaluate:
Sub Test()
Dim str As String: str = "MyExcelWorkbook_Management_20200602_MyName.xlsm"
Debug.Print Evaluate(Replace("=LEFT(""X"",MIN(FIND({0,1,2,3,4,5,6,7,8,9},ASC(""X"")&1234567890))-1)", "X", str))
End Sub
Pretty? Not really, but it does the job and got it's limitations.
You could use Regular Expressions to extract any letters / underscores before the number as well
Dim str As String
str = "MyExcelWorkbook_Management_20200602_MyName.xlsm"
With CreateObject("vbscript.regexp")
.Pattern = "^\D*"
.Global = True
MsgBox .Execute(str)(0)
End With
Gives:
MyExcelWorkbook_Management_
So basically you want to use the Midfunction to look for the first numerical character in your input string, and then cut your input string to that position.
That means we need to loop through the string from left to right, look at one character at a time and see if it is a digit or not.
This code does exactly that:
Option Explicit
Sub extratLeftText()
Dim someString As String
Dim result As String
someString = "Hello World1234"
Dim i As Long
Dim c As String 'one character of your string
For i = 1 To Len(someString)
c = Mid(someString, i, 1)
If IsNumeric(c) = True Then 'should write "If IsNumeric(c) = True AND i>1 Then" to avoid an "out of bounds" error
result = Left(someString, i - 1)
Exit For
End If
Next i
MsgBox result
End Sub
Last thing you need to do is to load in some workbook name into your VBA function. Generally this is done with the .Name method of the workbookobject:
Sub workbookName()
Dim wb As Workbook
Set wb = ActiveWorkbook
MsgBox wb.Name
End Sub
Of course you would need to find some way to replace the Set wb = ActiveWorkbook line with code that suits your purpose.

How to return worksheet or workbook name in cell

I am trying to create a code that outputs the date (e.g. 201607) contained within the workbook name (e.g. 20160701_tyo). In the following code, I specify which cell to output the value, but I always run into an error that I didn't "define my object". What am I missing?
Sub WorksheetDateName()
Dim DateName As String, OnlyDate As Long
DateName = ActiveWorkbook.Name
OnlyDate = Left(DateName.Value, 6)
ActiveWorksheet.Range("E1").Value = OnlyDate
End Sub
Also, would it be possible to perform something similar for "ActiveSheet" in addition to "ActiveWorkbook"? Thank you in advance!
For the Workbook name, you could use VBA:
ActiveSheet.Range("E1").Value = Left(ActiveWorkbook.Name, 6)
Or you could just use a formula in E1 such as:
=MID(CELL("filename"),FIND("[",CELL("filename"))+1,6)
For the Worksheet name, if you wanted the first 6 characters you could use VBA:
ActiveSheet.Range("F1").Value = Left(ActiveSheet.Name, 6)
and the equivalent formula would be:
=MID(CELL("filename"),FIND("]",CELL("filename"))+1,6)
Note: both Excel formula require that the file has been saved at least once previously to work correctly.
Looking through your code though, one way to 'fix' it would be to use Val to convert the 6 character string to a value, that can be held in the Long.
Sub WorksheetDateName()
Dim DateName As String, OnlyDate As Long
DateName = ActiveWorkbook.Name
OnlyDate = Val(Left(DateName, 6))
ActiveSheet.Range("G1").Value = OnlyDate
End Sub
You'll also note I've changed ActiveWorksheet to Activesheet - as other comments have suggested.

Excel VBA reference issues

I was following some examples online in which im trying to pass a value from one sub into a another sub in VBA but get the error:
Compile Error:
Procedure declaration does not match description of event or procedure having the same name.
Sub next_sat_click()
Dim iweekday As Integer
Dim nextsat As String
Dim index As Integer
Dim str_game_date As String
iweekday = weekday(Now(), vbSunday)
nextsat = Format((Now + 7 - iweekday), "mm-dd-yy")
Call set_button_Click(nextsat)
End Sub
Sub set_button_Click(ByRef nextsat As String)
......
End Sub
Change the sub name in something else like SetButtonOnClick.
The _Click keyword is reserved by excel for the Click event on buttons if you have a button called with the same name.
You can't change the parameters for an event handler (except for the parameter name). That also means you can't add any parameters if none are expected. Not even Optional ByRef nextsat As String will work.
There are three ways to pass a value between event handlers in a UserForm:
Using a global variable (not recommended, ever);
Via the UserForm.tag property (recommended for simple values such as strings). Obviously cannot be used if it already has a permanent use;
Via one or more hidden controls (recommended for multiple or complex values as well as simple ones).
I've used the second method:
Sub next_sat_click()
Dim iweekday As Integer
Dim nextsat As String
Dim index As Integer
Dim str_game_date As String
iweekday = Weekday(Now(), vbSunday)
nextsat = Format((Now + 7 - iweekday), "mm-dd-yy")
Me.Tag = nextsat
End Sub
Sub set_button_Click()
Dim nextsat As String
nextsat = Me.Tag
......
End Sub
A better solution in your case might be to have a visible TextBox in which you store the calculated date when the user clicks next_sat, so that the user can see it. Then in your set_button handler, grab it from TextBox.Text.

Use of Combobox to populate cell with functions and external links

It is very simple but yet I can't figure it out. Maybe because it cannot be done? Regardless here we go:
I would like to use a combobox that will, when selected, input cells with text values, functions and reference to external cells.
First line of the options would be to have the name populated.
Second line is a formula that would change from course to course.
Third line would provide a cell with a reference to another cell's content from another file. So if multiple course file are used I can have one master file that if I change the content of a cell the change will reflect on all the course file cells that are referring to it once updated.
This is in crude code form what I would like it to perform.
Private Sub ComboBox1_Change()
If Me.ComboBox1.Value = "ITCourse" Then
Worksheets("PARADE STATE").Range("I1").Value = "ITCourse"
Worksheets("Data Base").Range("C1").Value = IF(V9>70,"Prep Week",IF(V9>65,"Week 1",IF(V9>60,"Week 2",IF(V9>55,"Week 3",IF(V9>50,"Week 4",IF(V9>45,"Week 5",IF(V9>40,"Week 6",IF(V9>35,"Week 7",IF(V9>30,"Week 8",IF(V9>25,"Week 9",IF(V9>20,"Week 10",IF(V9>15,"Week 11",IF(V9>10,"Week 12",IF(V9>5,"Week 13",IF(V9>0,"Week 14")))))))))))))))
Worksheets("Week 1").Range("B2").Value = 'N:\ITcourse\00 - Data Base\[ITcourse.xlsx]Sheet'!$A$3
End If
If Me.ComboBox1.Value = "HRCourse" Then
Worksheets("PARADE STATE").Range("I1").Value = "HRCourse"
Worksheets("Data Base").Range("C1").Value = IF(V9>40,"Prep Week",IF(V9>35,"Week 1",IF(V9>30,"Week 2",IF(V9>25,"Week 3",IF(V9>20,"Week 4",IF(V9>15,"Week 5",IF(V9>10,"Week 6",IF(V9>5,"Week 7",IF(V9>5,"Week 8")))))))))
Worksheets("Week 1").Range("B2").Value = 'N:\ITcourse\00 - Data Base\[HRcourse.xlsx]Sheet'!$A$3
End If
End Sub
Thank you!
You need a function that returns the number of weeks for any given course name. This function should use a Dictionary to store the information, and the dictionary may be loaded from a dedicated worksheet.
Function WeeksPerCourse(courseName As String) As Long
Static dict As Scripting.Dictionary
If dict Is Nothing Then
' Fill the dictionary here. Note that it is better
' to load the values from a dedicated, hidden worksheet
Set dict = CreateObject("Scripting.Dictionary")
dict("ITCourse") = 14
dict("HRCourse") = 8
' Etc...
End If
WeeksPerCourse = dict(courseName)
End Function
With this function available, your procedure can be simplified like follows:
Private Sub ComboBox1_Change()
Dim course As Sting: course = Trim(ComboBox1.value)
Worksheets("PARADE STATE").Range("I1").value = course
'Dim nWeek As Long
'nWeek = WeeksPerCourse(course) - Worksheets("PARADE STATE").Range("V9").value / 5
'Worksheets("Data Base").Range("C1").value = IIf(nWeek < 1, "Prep Week", "Week " & nWeek)
Worksheets("Data Base").Range("C1").Formula = "= ""Week "" & INT((WeeksPerCourse('PARADE STATE'!I1) - 'PARADE STATE'!V9)/5)"
Worksheets("Week 1").Range("B2").Formula= "='N:\ITcourse\00 - Data Base\[" & course & ".xlsx]Sheet'!$A$3"
End Sub

Excel VBA - how to find the largest substring value in a column

I have a column in a spreadsheet.
The format of the data in each cell is aa-0001-xx.
I need to examine the whole column to find the highest value of the sequence number. this would be the substring from column4 thru column7.
I can find the sequence number using Mid(ActiveWorkbook.Sheets("Sheet1").Range("B2:B2"), 4, 4)
But I need to find the max sequence in the whole column.
I am doing this in VBA.
Any help would be appreciated.
Here is my code so far:
Private Sub CommandButton1_Click()
Dim sQuoteNumber As String
Dim sFileName As String
Dim sPathName As String
Dim checkit As String
'Log the Quote
'First, open the log file and determine the next sequential log number.
sPathName = "C:\Users\Rich\Documents\Bryan\BigProject\"
sFileName = "QuoteLog2016.xlsx"
ControlFile = ActiveWorkbook.Name
Workbooks.Open Filename:=sPathName & sFileName
'Create the new Quote Number
checkit = Mid(ActiveWorkbook.Sheets("Sheet1").Range("B2:B2"), 4, 4) ' This is a temp test line
If Mid(ActiveWorkbook.Sheets("Sheet1").Range("B2:B2"), 4, 4) = "" Then
sQuoteNumber = "16-0001"
Else
'find the biggest number
'Here I was looking to like pass the mid function to a Max function of some sort.
sQuoteNumber = "16-0002"
End If
MsgBox ("The new Quote Number is: " + sQuoteNumber)
'Save the log entry
Workbooks(sFileName).Close
All of the comments made to your answer would work well for you. It's also true that there's no evidence in your code at having attempted something, however rudimentary, and this is why answers to a rather trivial task are not forthcoming for you. Perhaps, in future, have a go at some kind of solution ( even if it feels more guesswork than anything) and people on this site will be much more supportive of you.
To set you on your way, you could make use of the Split() function which converts a String into a String array, separated by a nominated value - in the case of your quotations, you could use "-" as your separator. This might be easier than your Mid function and will deal with the case of different sized quotations.
The code below will get you started but you'd want some error handling in there to test, for example, that each cell splits appropriately or that any cells aren't blank. I'll leave all of that to you.
Option Explicit
Private mLastQuote As Long
Public Sub Test()
Initialise 'call this routine just once at the start of your project
MsgBox GetNextQuote(16) 'use the GetNextQuote() function to get next number
MsgBox GetNextQuote(16)
MsgBox GetNextQuote(16)
End Sub
Private Function GetNextQuote(prefix As Integer) As String
mLastQuote = mLastQuote + 1
GetNextQuote = CStr(prefix) & "-" & _
Format(mLastQuote, "000#")
End Function
Private Sub Initialise()
Const PATH_NAME As String = "C:\Users\Rich\Documents\Bryan\BigProject\"
Const FILE_NAME As String = "QuoteLog2016.xlsx"
Const QUOTE_COL As String = "B"
Dim wb As Workbook
Dim ws As Worksheet
Dim v As Variant
Dim r As Long
Dim parts() As String
Dim num As Long
Application.ScreenUpdating = False
Set wb = Workbooks.Open(PATH_NAME & FILE_NAME, True, True)
Set ws = wb.Worksheets("Sheet1")
'Read quote values into variant array
With ws
v = .Range(.Cells(2, QUOTE_COL), _
.Cells(.Rows.Count, QUOTE_COL).End(xlUp)) _
.Value2
End With
'Find max quote
For r = 1 To UBound(v, 1)
parts = Split(v(r, 1), "-") 'splits quote into 3 parts
num = CLng(parts(1)) 'index (1) is the middle part
If num > mLastQuote Then mLastQuote = num
Next
wb.Close False
Application.ScreenUpdating = True
End Sub

Resources