CODEWITHSUNDEEP
arraysvbaexcelif-statement
MSL
MSL

Reputation: 65

Array of months with ranges

I am currently trying to create an array that includes every month shortened down to 3 letters, etc. "JAN". I'd however like to assign every month with a specific range that can be used to etc. paste values.

I have tried the following to no avail: (Error: Subscript out of range)

Sub Button1_Click()
Dim celltxt As String
celltxt = Worksheets("FH EXPORT").range("A2").Text
Set ws = Worksheets("Report")
Set genRng = ws.range("B2:B10")
Dim MonthName As Variant
MonthName = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")

months(1) = ws.range("E2:E10")
months(2) = ws.range("F2:F10")
months(3) = ws.range("G2:E10")
months(4) = ws.range("H2:H10")
months(5) = ws.range("I2:I10")
months(6) = ws.range("J2:J10")
months(7) = ws.range("K2:K10")
months(8) = ws.range("L2:L10")
months(9) = ws.range("M2:M10")
months(10) = ws.range("N2:N10")
months(11) = ws.range("O2:N10")
months(12) = ws.range("P2:P10")
If InStr(1, celltxt, "JAN") Then
months(1).Value = genRng.Value
ElseIf InStr(1, celltxt, "FEB") Then
months(2).Value = genRng.Value
Else
    MsgBox ("not found")
End If
End Sub

The whole reason for me attempting this is actually to avoid creating an if statement for every single month, also as shown in the code.

Upvotes: 0

Views: 711

Answers (2)

QHarr
QHarr

Reputation: 84465

Something like

Version 1: Simpler

Option Explicit

Public Sub Button1_Click()

    Dim celltxt As String, ws As Worksheet, genRng As Range, MonthNames,  i As Long
    celltxt = Worksheets("FH EXPORT").Range("A2").Text
    Set ws = Worksheets("Report")
    Set genRng = ws.Range("B2:B10")
    MonthNames = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")

    For i = LBound(MonthNames) To UBound(MonthNames)
      'split celltxt on the search string MonthNames(i) e.g. Jan and test to see if resultant array has more than 1 item (ubound indicates number) i.e. was able to split because was present
       ' add an Or in case celltxt is only 3 characters long and is a match e.g. celltxt is Jan only.
         If UBound(Split(LCase$(celltxt), LCase$(MonthNames(i)))) > 0 Or LCase$(celltxt) = LCase$(MonthNames(i)) Then
            ws.Range("E2:E10").Offset(, i) = genRng.Value
            End
        End If
    Next i
    MsgBox ("not found")
End Sub

Version 2:

Option Explicit

Public Sub Button1_Click()

    Dim celltxt As String, ws As Worksheet, genRng As Range, MonthNames, i As Long, found As Boolean
    celltxt = Worksheets("FH EXPORT").Range("A2").Text
    Set ws = Worksheets("Report")
    Set genRng = ws.Range("B2:B10")
    MonthNames = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec") '<==array holding the month abbreviations

    For i = LBound(MonthNames) To UBound(MonthNames) 'loop the entire array e.g. Jan, Feb
        On Error Resume Next 'prepare for if not found error being thrown
        If IsError(Application.WorksheetFunction.Find(LCase$(MonthNames(i)), LCase$(celltxt))) Then 'test if error returned i.e. value not found
            GoTo NextLine 'if error found then current array item e.g. Jan was not found so go to the line that says NextLine
        Else
            ws.Range("E2:E10").Offset(, i) = genRng.Value 'no error so we know found and can set
            End 'exit progam as found
        End If
ResumeLine:
    Next i
    If Not found Then MsgBox ("not found")
    Exit Sub
NextLine:   'this handles the error by clearing it and then sending the program back to loop to try again with next array item e.g. Feb
    Err.Clear 'clear error
    GoTo ResumeLine 'go back to next i
End Sub

Version 3 using LCase$ for comparison 

Public Sub Button1_Click()

    Dim celltxt As String, ws As Worksheet, genRng As Range, MonthNames, i As Long
    celltxt = LCase$(Worksheets("FH EXPORT").Range("A2").Text)
    Set ws = Worksheets("Report")
    Set genRng = ws.Range("B2:B10")
    MonthNames = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")

    For i = LBound(MonthNames) To UBound(MonthNames)

        If InStr(1, celltxt, LCase$(MonthNames(i))) > 0 Then
            ws.Range("E2:E10").Offset(, i) = genRng.Value
            End
        End If
    Next i
    MsgBox ("not found")
End Sub

Upvotes: 1

Banana
Banana

Reputation: 7463

Are you sure that you need an array? you could just generate month names on the fly:

Dim celltxt As String
Dim genRng  As Range
Set genRng = ActiveSheet.Range("B2:B10")
Dim ws As Worksheet
Set ws = Worksheets("Report")
celltxt = Worksheets("FH EXPORT").range("A2").Text
For m_ = 1 To 12
    If (InStr(1, UCase(celltxt), UCase(Format(DateSerial(1, m_, 1), "mmm")))) > 0 Then
        ws.Range("D2:D10").Offset(0, m_).Value = genRng.Value
        Exit Sub
    End If
Next m_

Explanation:

example for m_ = 1

DateSerial(1, m_, 1)

Line above generates a date object with value "1/1/2001"

Format(DateSerial(1, m_, 1), "mmm")

Line above generates "Jan"

UCase(Format(DateSerial(1, m_, 1), "mmm")

Line above generates "JAN"

And then you compare your A2 cell's uppercase value UCase(celltxt) against this "JAN" and copy your range accordingly to your destination, starting from your E column, ofsetted by the month number m_ from the loop.

UPDATE:

hehe if cell A2 always has 3 letters short month, then here is a one liner:

Worksheets("Report").Range("D2:D10").Offset(0, Month(DateValue(Right(Left(Split(Worksheets("FH EXPORT").Range("A2").Text, " ")(1), 5), 3) & " 1"))).Value = Worksheets("Report").Range("B2:B10").Value

Upvotes: 0

Related Questions