To simplify the VBA code below

[ChanL]

Hi, i am new to VBA and i tried to write a code a below for me to automated a reporting task.
Is there anyway to simpilify the code, as i feel like its too lengthy and immature.

Sub working()
'populate the month based on the reporting period

Dim reportprd As String

Set dessh1 = ThisWorkbook.Sheets("Part 1")
Set dessh2 = ThisWorkbook.Sheets("Part 2")
Set dessh3 = ThisWorkbook.Sheets("Part 3")

reportprd = ThisWorkbook.Sheets("Main").Range("I10").Value

If reportprd = "1H" Then
With dessh1
.Range("B1").MergeArea.Value = "Jan"
.Range("E1").MergeArea.Value = "Feb"
.Range("H1").MergeArea.Value = "Mar"
.Range("K1").MergeArea.Value = "Apr"
.Range("N1").MergeArea.Value = "May"
.Range("Q1").MergeArea.Value = "Jun"
End With

With dessh2
.Range("B1").MergeArea.Value = "Jan"
.Range("E1").MergeArea.Value = "Feb"
.Range("H1").MergeArea.Value = "Mar"
.Range("K1").MergeArea.Value = "Apr"
.Range("N1").MergeArea.Value = "May"
.Range("Q1").MergeArea.Value = "Jun"
End With


With dessh3
.Range("A5").Value = "Jan"
.Range("A6").Value = "Feb"
.Range("A7").Value = "Mar"
.Range("A8").Value = "Apr"
.Range("A9").Value = "May"
.Range("A10").Value = "Jun"
.Range("A16").Value = "Jan"
.Range("A17").Value = "Feb"
.Range("A18").Value = "Mar"
.Range("A19").Value = "Apr"
.Range("A20").Value = "May"
.Range("A21").Value = "Jun"
.Range("A27").Value = "Jan"
.Range("A28").Value = "Feb"
.Range("A29").Value = "Mar"
.Range("A30").Value = "Apr"
.Range("A31").Value = "May"
.Range("A32").Value = "Jun"
End With

Else

With dessh1

.Range("B1").MergeArea.Value = "Jul"

.Range("E1").MergeArea.Value = "Aug"

.Range("H1").MergeArea.Value = "Sep"

.Range("K1").MergeArea.Value = "Oct"

.Range("N1").MergeArea.Value = "Nov"

.Range("Q1").MergeArea.Value = "Dec"

End With



With dessh2

.Range("B1").MergeArea.Value = "Jul"

.Range("E1").MergeArea.Value = "Aug"

.Range("H1").MergeArea.Value = "Sep"

.Range("K1").MergeArea.Value = "Oct"

.Range("N1").MergeArea.Value = "Nov"

.Range("Q1").MergeArea.Value = "Dec"

End With



With dessh3

.Range("A5").Value = "Jul"

.Range("A6").Value = "Aug"

.Range("A7").Value = "Sep"

.Range("A8").Value = "Oct"

.Range("A9").Value = "Nov"

.Range("A10").Value = "Dec"

.Range("A16").Value = "Jul"

.Range("A17").Value = "Aug"

.Range("A18").Value = "Sep"

.Range("A19").Value = "Oct"

.Range("A20").Value = "Nov"

.Range("A21").Value = "Dec"

.Range("A27").Value = "Jul"

.Range("A28").Value = "Aug"

.Range("A29").Value = "Sep"

.Range("A30").Value = "Oct"

.Range("A31").Value = "Nov"

.Range("A32").Value = "Dec"

End With



End If



End Sub

 

[PeteWright]

Could you provide the Excel sheet(s) that a populated?
It is not clear to me, what you want to simplify.

 

[Georgiboy]

Getting rid of merged cells would be a great start, they are a nightmare for using VBA.

 

[Snakehips]

@ChanL Well done for creating your working code. It is arguably length but it is tidy and coded rather than unnecessarily cluttered recorded macro content.
Agree with @Georgiboy re the use of merged cells! You could see if you can utilise cells formatted so that 'Horizontal Alignment' is 'Center Across Selection'

If you do then there are alternative approaches you could use to shorten your code if you wish to, such as the below.

Sub ChanL()
'populate the month based on the reporting period
Dim mth As Integer
Dim r As Integer
Dim m As Integer
Dim reportprd As String
Dim mtxt As String

Set dessh1 = ThisWorkbook.Sheets("Part 1")
Set dessh2 = ThisWorkbook.Sheets("Part 2")
Set dessh3 = ThisWorkbook.Sheets("Part 3")

reportprd = ThisWorkbook.Sheets("Main").Range("I10").Value

mth = 7  'start with July
If reportprd = "1H" Then mth = 1  'Start with January

For m = 0 To 5  'm = month offset
    mtxt = Format("1/" & mth + m & "/2000", "mmm")    'create short month as text
    
    dessh1.Range("B1").Offset(0, m * 3).Value = mtxt
    dessh2.Range("B1").Offset(0, m * 3).Value = mtxt
         
    For r = 0 To 2   'r = group rows offset
        dessh3.Range("A5").Offset(m + (r * 11), 0).Value = mtxt
    Next r
Next m

End Sub

Hope that helps.

 

[ChanL]

@ChanL Well done for creating your working code. It is arguably length but it is tidy and coded rather than unnecessarily cluttered recorded macro content.
Agree with @Georgiboy re the use of merged cells! You could see if you can utilise cells formatted so that 'Horizontal Alignment' is 'Center Across Selection'

If you do then there are alternative approaches you could use to shorten your code if you wish to, such as the below.

Sub ChanL()
'populate the month based on the reporting period
Dim mth As Integer
Dim r As Integer
Dim m As Integer
Dim reportprd As String
Dim mtxt As String

Set dessh1 = ThisWorkbook.Sheets("Part 1")
Set dessh2 = ThisWorkbook.Sheets("Part 2")
Set dessh3 = ThisWorkbook.Sheets("Part 3")

reportprd = ThisWorkbook.Sheets("Main").Range("I10").Value

mth = 7  'start with July
If reportprd = "1H" Then mth = 1  'Start with January

For m = 0 To 5  'm = month offset
    mtxt = Format("1/" & mth + m & "/2000", "mmm")    'create short month as text
   
    dessh1.Range("B1").Offset(0, m * 3).Value = mtxt
    dessh2.Range("B1").Offset(0, m * 3).Value = mtxt
        
    For r = 0 To 2   'r = group rows offset
        dessh3.Range("A5").Offset(m + (r * 11), 0).Value = mtxt
    Next r
Next m

End Sub

Hope that helps.

thanks for the kind words. Indeed i want to get rid of the mergearea.value line, cox it feels like too lengthy and very amature eventhough its working fine, but the thing is the cell in the workbook itself using merged cell, so i cnnt seem to ignore that. Let me try this code of urs n get bck to u!

 

[ChanL]

Getting rid of merged cells would be a great start, they are a nightmare for using VBA.

but my values are in merged cells. that's why i using that. I was thinking whether i can use an array("Jan","Feb"....) and populate into each of the cells accordingly. bt with my cells being merged, i tried a few times bt it seem nt working fine

 

[Snakehips]

You could use an array but will still probably need to loop to assign the values, because of the offset nature of the receiving cells in the first two sheets.
If you can change the merged cells to 'center accross selection' as suggested then the visual effect will be exactly the same and the coding less prone to issue.
Or.... stick with your original code?

 

[ChanL]

You could use an array but will still probably need to loop to assign the values, because of the offset nature of the receiving cells in the first two sheets.
If you can change the merged cells to 'center accross selection' as suggested then the visual effect will be exactly the same and the coding less prone to issue.
Or.... stick with your original code?

i guess sometime we need to bare with lengthy codes ! most inmportantly is the outcome lmao hahaha

 

[dmt32]

i guess sometime we need to bare with lengthy codes ! most inmportantly is the outcome lmao hahaha

If you really must keep the merged cells then you can create an array of month names to post values to receiving cells but as stated, likely to need because of their offset nature, to step through each element to post in first two sheets & similar with third sheets 3 areas.

see if following code will do what you want

Option Explicit
Sub working()
    'populate the month based on the reporting period
    Dim wsDes(1 To 3)   As Worksheet
    Dim Area            As Range, rng As Range
    Dim i               As Long, c As Long, sh As Long
    Dim arr             As Variant
    Dim FirstPeriod     As Boolean
    Dim reportprd       As String
   
    Const JanToJun As Long = 1, JulToDec As Long = 7
   
    'create array of abbreviated month names
    arr = Application.GetCustomListContents(xlMonth)
   
    Set rng = ThisWorkbook.Worksheets("Main").Range("I10")
   
    reportprd = UCase(Trim(rng.Value))
   
    FirstPeriod = CBool(reportprd = "1H")
   
    For sh = 1 To 3
        Set wsDes(sh) = ThisWorkbook.Worksheets("Part " & sh)
       
        If sh < 3 Then
           
            i = IIf(FirstPeriod, JanToJun, JulToDec)
           
            For c = 2 To 17 Step 3
                'post elements to merged cells
                wsDes(sh).Cells(1, c).MergeArea.Value = arr(i)
                i = i + 1
            Next c
           
        Else
           
            For Each Area In wsDes(sh).Range("A5:A10,A16:A21,A27:A32").Areas
                'slice array based on period & post to range
                Area.Value = Application.Transpose(Application.Index(arr, 0, _
                             IIf(FirstPeriod, Array(1, 2, 3, 4, 5, 6), _
                                              Array(7, 8, 9, 10, 11, 12))))
            Next Area
           
        End If
       
    Next sh
   
End Sub

Personally, I agree with others here, try an avoid merged cells as you can see, solution not as compact as one suggested by @Snakehips but gives another idea to work with.

Hope Helpful

Dave