Create Array: VBA

Zack Barresse

MrExcel MVP
Joined
Dec 9, 2003
Messages
10,881
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
  2. Mobile
  3. Web
Hello everybody,


In VBA, I think an array might be more efficient than what I've got now. I wrote a large piece of code and at one point, use a Select Case to check the first three letters of an objects name, finding for month names. Something like this ...


<font face=Tahoma New>            <SPAN style="color:#00007F">Select</SPAN> <SPAN style="color:#00007F">Case</SPAN> Left(LCase(ws.Name), 3)
            Case "jan", "feb", "mar", "apr", "may", "jun", "jul", "aug", "sep", "oct", "nov", "dec"</FONT>


I have to do this many times, so this is inside of a loop (two loops actually). What I'm wondering, is if I put these values in an array, would that be more efficient and/or faster? I am not versed well in creating/utilizing arrays in VBA. I could also post the entire code if needed, although it's quite long; whichever would be required: a more detailed explanation, or the entire code.
 

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
Without seeing the entire code to assess your posted portion's context, it's too hard to say what would be more efficient. One thing you can possibly do is, enter this in IV1:IV12 (or some out of the way range) on Sheet1:

Jan
Feb
Mar
Apr
May
Jun
Jul
Aug
Sep
Oct
Nov
Dec

Then at the beginning of your macro outside of any loop:

Dim EvalRange As Range, ws As Worksheet
Set EvalRange = Sheets("Sheet1").Range("IV1:IV12")

Then maybe inside of whatever loop you are doing (this is where it gets tough to know if this will help, I used a worksheet collection example), use this Countif approach instead of evaluating the same set of 12 Case elements every time:

For Each ws In Worksheets
If WorksheetFunction.CountIf(EvalRange, Left(ws.Name, 3)) > 0 Then
MsgBox ws.Name & " evaluates to True."
End If
Next ws


Just guessing at what might help; not much else to go on without further background.
 
Upvote 0
Firefytr,

a little idea...
since you want to win running time
let me put things upside-down if you understand what I mean

supposing you want to write to one of 12 sheets called "jan", ... but only when you find a match : Left(LCase(ws.Name), 3)

couldn't you perform the operation as if the mach was already found?
when there is a match it will work
when there isn't you get an error which you could handle

hmm,
is this clear or are you searching for something totally else?

kind regards,
Erik
 
Upvote 0
Hi Zack, :-)
Mostly my opinion is same what Tom says. We need whole code to know what exactly you are going to do.
In fact, using an array for looping may fast but actually to make the code more efficient, we need to think how to avoid using a loop.

Many case can be thought from your posting....here is a sample using Application.Match to get the order in an array.
Code:
    Dim arr, ret
    arr = Array("jan", "feb", "mar", "apr", "may", "jun", "jul", "aug", "sep", "oct", "nov", "dec")
    ret = Application.Match(Left(LCase(ws.Name), 3), arr, 0)
    If Not IsError(ret) Then
        MsgBox ret
    Else
        MsgBox "not found in the array"
    End If

or if you have the data on the wks and you'd like to use it as an array, I think this tip helps you.
http://puremis.net/excel/code/053.shtml

Anyway let us have more information please.
 
Upvote 0
Heres another example but using the data function to create Jan,Feb etc and returning the month name based on the month number entered. A function may be what you require but depends on what your trying to achieve.


Code:
Sub ArrayExample()
Dim MthArr(1 To 12), i As Integer, RetVal As Variant, Result As String

'Populate months to an array
For i = 1 To 12
MthArr(i) = Format(Evaluate("Date(2000," & CStr(i) & ",1)"), "MMM")
Next i

'Ask User for month

RetVal = Application.InputBox("Enter a number between 1 and 12", "Month #", Type:=1)

'Return the appropriate message

On Error Resume Next
Result = MthArr(RetVal)

If Err.Number <> 0 Then
    MsgBox "You must enter a number between 1-12!", vbCritical, "Invalid Month Number"
Else
    MsgBox "The month name is " & Result
End If

Err.Clear
On Error GoTo 0
 
End Sub
 
Upvote 0
Thank you all very much for responding!! I am honored by the expertise of all. Here is my full code..

<font face=Tahoma New><SPAN style="color:#00007F">Sub</SPAN> Find_Monthly_Values()
    Application.DisplayAlerts = <SPAN style="color:#00007F">False</SPAN>
    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN>
<SPAN style="color:#007F00">'--------------------------------------------------------------------</SPAN>
    <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">Resume</SPAN> <SPAN style="color:#00007F">Next</SPAN>
    <SPAN style="color:#00007F">Dim</SPAN> ws <SPAN style="color:#00007F">As</SPAN> Worksheet, thisWb <SPAN style="color:#00007F">As</SPAN> Workbook, thisWs <SPAN style="color:#00007F">As</SPAN> Worksheet, waterWb <SPAN style="color:#00007F">As</SPAN> Workbook
    <SPAN style="color:#00007F">Dim</SPAN> i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, lastRow <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
    <SPAN style="color:#00007F">Dim</SPAN> findValue <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>, lookRng <SPAN style="color:#00007F">As</SPAN> Range, foundRng <SPAN style="color:#00007F">As</SPAN> Range
    <SPAN style="color:#00007F">Dim</SPAN> monthCol <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, monthVal <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, notFoundList <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>
    <SPAN style="color:#00007F">Dim</SPAN> tmpSht <SPAN style="color:#00007F">As</SPAN> Worksheet, hasErr <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Boolean</SPAN>, lRow <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
    <SPAN style="color:#00007F">Dim</SPAN> fPath <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>, fName <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>, tmpThisWb <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>
    <SPAN style="color:#00007F">Dim</SPAN> Year4 <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>, Year2 <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>
    <SPAN style="color:#00007F">Dim</SPAN> varFileFind <SPAN style="color:#00007F">As</SPAN> Range, fileFoundRng <SPAN style="color:#00007F">As</SPAN> Range
<SPAN style="color:#007F00">'--------------------------------------------------------------------</SPAN>
    Year4 = ActiveSheet.Range("A1").Text
    Year2 = Right(Year4, 2)
    <SPAN style="color:#00007F">Set</SPAN> varFileFind = Sheets("Admin").Range("A:A")
    <SPAN style="color:#00007F">Set</SPAN> fileFoundRng = varFileFind.Find("WTR" & Year2 & ".xls", _
                                        after:=varFileFind.Cells(1), _
                                        lookat:=xlWhole, _
                                        MatchCase:=True)
    <SPAN style="color:#00007F">If</SPAN> fileFoundRng <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN>
        MsgBox "The file was not found on file!" & vbNewLine & vbNewLine & _
            "Please contact your systems" & vbNewLine & "adminstrator.", _
            vbExclamation, "ERROR!"
        <SPAN style="color:#00007F">GoTo</SPAN> EndMeNow
    End <SPAN style="color:#00007F">If</SPAN>
    fPath = fileFoundRng.Offset(, 1).Value & fileFoundRng.Value
    fName = fileFoundRng.Value
    fileFoundRng.Offset(, 2).Value = Format(Date, "dd-mmm-yy")
    tmpThisWb = ThisWorkbook.Name
    Workbooks(fName).Activate
    <SPAN style="color:#00007F">If</SPAN> Err = 0 <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> hasItOpen
    Err.Clear
    Workbooks.Open (fPath)
hasItOpen:
    Workbooks(tmpThisWb).Activate
    <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> 0
<SPAN style="color:#007F00">'--------------------------------------------------------------------</SPAN>
    <SPAN style="color:#00007F">Set</SPAN> thisWb = ThisWorkbook
    <SPAN style="color:#00007F">Set</SPAN> thisWs = thisWb.Sheets(Year4)
    <SPAN style="color:#00007F">Set</SPAN> waterWb = Workbooks(fileFoundRng.Value)
    lastRow = thisWs.Range("A65536").<SPAN style="color:#00007F">End</SPAN>(xlUp).Row
    hasErr = <SPAN style="color:#00007F">False</SPAN>
    <SPAN style="color:#00007F">For</SPAN> i = 4 <SPAN style="color:#00007F">To</SPAN> lastRow <SPAN style="color:#00007F">Step</SPAN> 1
        findValue = thisWs.Range("A" & i).Value
        <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> ws <SPAN style="color:#00007F">In</SPAN> waterWb.Worksheets
            <SPAN style="color:#00007F">Select</SPAN> <SPAN style="color:#00007F">Case</SPAN> Left(LCase(ws.Name), 3)
            Case "jan", "feb", "mar", "apr", "may", "jun", "jul", "aug", "sep", "oct", "nov", "dec"
                <SPAN style="color:#00007F">Set</SPAN> lookRng = ws.Range("B62:AY62")
                <SPAN style="color:#00007F">Set</SPAN> foundRng = lookRng.Find(thisWs.Cells(i, 1).Value, _
                                            lookat:=xlWhole, _
                                            Match<SPAN style="color:#00007F">Case</SPAN>:=True)
                <SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">Not</SPAN> foundRng <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN>
                    monthCol = FindTheMonth(foundRng.Parent.Name)
<SPAN style="color:#007F00">'----------------------------------------------------------------</SPAN>
                    <SPAN style="color:#007F00">'monthVal = IsDuplicate(foundRng.Offset(34), i, thisWs)</SPAN>
                    monthVal = foundRng.Offset(34).Value
<SPAN style="color:#007F00">'----------------------------------------------------------------</SPAN>
                    thisWs.Cells(i, monthCol).Value = monthVal
                <SPAN style="color:#00007F">Else</SPAN>
                    <SPAN style="color:#00007F">If</SPAN> hasErr = <SPAN style="color:#00007F">False</SPAN> <SPAN style="color:#00007F">Then</SPAN>
                        <SPAN style="color:#00007F">Set</SPAN> tmpSht = thisWb.Worksheets.Add
                    End <SPAN style="color:#00007F">If</SPAN>
                    hasErr = <SPAN style="color:#00007F">True</SPAN>
                    tmpSht.[A65536].<SPAN style="color:#00007F">End</SPAN>(xlUp).Offset(1).Value = _
                        thisWs.Cells(i, 1).Value
                <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
                <SPAN style="color:#00007F">Set</SPAN> foundRng = <SPAN style="color:#00007F">Nothing</SPAN>
            <SPAN style="color:#00007F">Case</SPAN> <SPAN style="color:#00007F">Else</SPAN>
            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Select</SPAN>
        <SPAN style="color:#00007F">Next</SPAN> ws
    <SPAN style="color:#00007F">Next</SPAN> i
    <SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">Not</SPAN> tmpSht <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN>
        <SPAN style="color:#00007F">With</SPAN> tmpSht
            <SPAN style="color:#00007F">With</SPAN> .Range("A1")
                .Value = "Not Found:"
                .Font.Bold = <SPAN style="color:#00007F">True</SPAN>
                .Font.Name = "Veranda"
                .Font.Size = 14
            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN>
            .Range("A:A").AdvancedFilter xlFilterInPlace, , , <SPAN style="color:#00007F">True</SPAN>
            .Cells.EntireColumn.AutoFit
            .PrintOut copies:=1
            .Delete
        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN>
    End <SPAN style="color:#00007F">If</SPAN>
    <SPAN style="color:#00007F">With</SPAN> thisWs
        lRow = .Range("A65536").<SPAN style="color:#00007F">End</SPAN>(xlUp).Row
        .Range("Q4", .Range("Q" & lRow)).FormulaR1C1 = _
            "=SUM(RC[-13]:RC[-2])"
        .Range("Q:Q").Font.Bold = <SPAN style="color:#00007F">True</SPAN>
        .Cells.EntireColumn.AutoFit
        .Range("A3", .Range("Q" & lRow)).AutoFilter field:=1
        .Activate
    End <SPAN style="color:#00007F">With</SPAN>
<SPAN style="color:#00007F">End</SPAN>MeNow:
    Application.DisplayAlerts = <SPAN style="color:#00007F">True</SPAN>
    Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN>
    MsgBox "Complete!"
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>

<SPAN style="color:#00007F">Function</SPAN> FindTheMonth(strMonth <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>) <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
    <SPAN style="color:#00007F">Dim</SPAN> currMonth <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>
    currMonth = Left(strMonth, 3)
    <SPAN style="color:#00007F">Select</SPAN> <SPAN style="color:#00007F">Case</SPAN> currMonth
    <SPAN style="color:#00007F">Case</SPAN> "Jan": FindTheMonth = 4
    <SPAN style="color:#00007F">Case</SPAN> "Feb": FindTheMonth = 5
    <SPAN style="color:#00007F">Case</SPAN> "Mar": FindTheMonth = 6
    <SPAN style="color:#00007F">Case</SPAN> "Apr": FindTheMonth = 7
    <SPAN style="color:#00007F">Case</SPAN> "May": FindTheMonth = 8
    <SPAN style="color:#00007F">Case</SPAN> "Jun": FindTheMonth = 9
    <SPAN style="color:#00007F">Case</SPAN> "Jul": FindTheMonth = 10
    <SPAN style="color:#00007F">Case</SPAN> "Aug": FindTheMonth = 11
    <SPAN style="color:#00007F">Case</SPAN> "Sep": FindTheMonth = 12
    <SPAN style="color:#00007F">Case</SPAN> "Oct": FindTheMonth = 13
    <SPAN style="color:#00007F">Case</SPAN> "Nov": FindTheMonth = 14
    <SPAN style="color:#00007F">Case</SPAN> "Dec": FindTheMonth = 15
    Case Else: FindTheMonth = 16 <SPAN style="color:#007F00">'extra column</SPAN>
    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Select</SPAN>
End <SPAN style="color:#00007F">Function</SPAN></FONT>



It may not be the best, but it gets the job done. I can't seem t o get the HTML Maker to work, else I would post a sample of my data structure.

Basically, this is a new spreadsheet that I created, which will open and retreive specific data from another spreadsheet. These other spreadsheets are inherited and are not laid out as they should have been. And rather than re-create them (which I may have to do) I was trying to bring together all of the information to one location. Each file represents one full calendar year (Jan 1 - Dec 31) of water/wastewater meter readings. The figures being returned are the monthly totals.

In cell A1 of each sheet is the year of the water report I wish to query. From A4:AlastRow is the data headings I need returned. The headings found on the annual water sheets will always be a set amount of rows above the figures I need retreived. D3:O3 on my summary workbook ("WaterTotals.xls") are listed January - December. So the figures retreived will go into the matrix of D4:OlastRow.

Let me know if further explanation is needed. Any pointers here would be much appreciated. Thanks for you help guys!! :-)
 
Upvote 0
Hi Zack,

I haven't looked at the main routine in detail yet but it looks as if the function at the end could be reduced to:
Code:
Function FindTheMonth2(strMonth As String) As Long
    FindTheMonth2 = Month(DateValue(strMonth & " 1")) + 3
End Function
Unless I'm missing something? ;)
 
Upvote 0
Well it looks like Richie was too quick for me - I was going to post this:

<font face=Courier New>
<SPAN style="color:#00007F">Function</SPAN> FindTheMonth(strMonth <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>) <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN>
    <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">Resume</SPAN> <SPAN style="color:#00007F">Next</SPAN>
    FindTheMonth = 16
    FindTheMonth = Month(DateValue("1-" & strMonth & "-04")) + 3
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Function</SPAN>
</FONT>

For an alternate to your function.

As for the main, I'm thinking InStr(), but will post back after pondering further.
 
Upvote 0
Hi Richie!

The strMonth variable will come across with a three character month and a two digit year. So January of 2003 would be Jan03, and August 2004 would be Aug04. So yes, I could use that, thank you! Using ...

<font face=Tahoma New><SPAN style="color:#00007F">Function</SPAN> FindTheMonth(strMonth <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>) <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
    FindTheMonth = Month(DateValue(Left(strMonth, 3) & " 1")) + 3
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Function</SPAN></FONT>

Edit: Hi Greg! Thank you! :bow:
 
Upvote 0
Zack,

Your select case solution doesn't seem all that horrendous to me. I didn't look too closely at the rest of your code, but in looking at that particular part the following occurs to me:

If InStr(1, "|jan|feb|mar|apr|may|jun|jul|aug|sep|oct|nov|dec|", "|" & Left(LCase(ws.Name), 3) & "|") Then

but whether that would execute faster then what you've got, I don't know.
 
Upvote 0

Forum statistics

Threads
1,226,618
Messages
6,192,050
Members
453,693
Latest member
maverick688

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top