none
Macro to Link Cells between two sheets RRS feed

  • Question

  • Is there a short way to achieve the below?
    The below code works fine but I think that there should be a better way
    Thanks!
     Sub MthlyFuelUtility()
    Dim Mth As String
    Dim UF_Data As Worksheet

    Set UF_Data = Sheets("sheet2")
    UF_Data.Select
     Mth = Month(Range("d23"))

    Sheets("sheet1").Select

    If Mth = "7" Then
    Range("E22") = UF_Data.Range("E33")
    Range("E23") = UF_Data.Range("E36")
    Range("E24") = UF_Data.Range("E39")
    Range("E25") = UF_Data.Range("E42")

    ElseIf Mth = "8" Then
    Range("F22") = UF_Data.Range("E33")
    Range("F23") = UF_Data.Range("E36")
    Range("F24") = UF_Data.Range("E39")
    Range("F25") = UF_Data.Range("E42")
    ElseIf Mth = "9" Then
    Range("G22") = UF_Data.Range("E33")
    Range("G23") = UF_Data.Range("E36")
    Range("G24") = UF_Data.Range("E39")
    Range("G25") = UF_Data.Range("E42")

    ElseIf Mth = "10" Then
    Range("H22") = UF_Data.Range("E33")
    Range("H23") = UF_Data.Range("E36")
    Range("H24") = UF_Data.Range("E39")
    Range("H25") = UF_Data.Range("E42")

    ElseIf Mth = "11" Then
    Range("I22") = UF_Data.Range("E33")
    Range("I23") = UF_Data.Range("E36")
    Range("I24") = UF_Data.Range("E39")
    Range("I25") = UF_Data.Range("E42")


    Else
    MsgBox ("Error")
    End If

    Thursday, August 17, 2017 7:19 PM

Answers

  • Mth = VBA.Month(UF_Data.Range("D23").Value)
    If Mth > 12 Or Mth < 1 Then
    Msgbox "you dummy"
    Exit Sub
    End If

    • Marked as answer by tuchellis Monday, September 11, 2017 2:18 PM
    Friday, August 18, 2017 4:09 PM
  • Just for completeness:

    Get rid of the IF (  If Mth >= 7 And Mth <= 12 Then) Else, <g class="gr_ gr_113 gr-alert gr_spell gr_inline_cards gr_run_anim ContextualSpelling ins-del" data-gr-id="113" id="113">Msgbox</g>, and End If and use this:

            shtT.Range("E22")(1, IIF(Mth>6,Mth - 6,Mth+ 6)).Value = UF_Data.Range("E33").Value
            shtT.Range("E23")(1, IF(Mth>6,Mth - 6,Mth+ 6)).Value = UF_Data.Range("E36").Value
            shtT.Range("E24")(1, IF(Mth>6,Mth - 6,Mth+ 6)).Value = UF_Data.Range("E39").Value
            shtT.Range("E25")(1, IF(Mth>6,Mth - 6,Mth+ 6)).Value = UF_Data.Range("E42").Value

    • Marked as answer by tuchellis Monday, September 11, 2017 2:18 PM
    Saturday, August 19, 2017 4:16 AM

All replies

  • Try this version:

    Sub MthlyFuelUtility()
        Dim Mth As Long
        Dim UF_Data As Worksheet
        Dim i As Long
    
        Set UF_Data = Sheets("sheet2")
        Mth = Month(UF_Data.Range("D23"))
        If Mth < 7 Or Mth > 11 Then
            MsgBox "Incorrect month!", vbExclamation
            Exit Sub
        End If
    
        Application.ScreenUpdating = False
        Sheets("sheet1").Select
        For i = 1 To 4
            Cells(i + 21, Mth - 2) = UF_Data.Cells(3 * i + 30, 5)
        Next i
        Application.ScreenUpdating = True
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Thursday, August 17, 2017 8:40 PM
  • tuchellis,
    Re: shorter code

    Another way to shorten your code is...
    Sub MthlyFuelUtilityR1()
     Dim Mth As Integer
     Dim UF_Data As Worksheet
     Dim MyArr As Variant
     
     Set UF_Data = Sheets("sheet2")
     Mth = VBA.Month(UF_Data.Range("d23").Value)
     MyArr = Array(UF_Data.Range("E33").Value, UF_Data.Range("E36").Value, _
                           UF_Data.Range("E39").Value, UF_Data.Range("E42").Value)
     MyArr = Application.WorksheetFunction.Transpose(MyArr)
     
     If Mth = 7 Then
     Sheets("sheet1").Range("E22:E25").Value = MyArr
     ElseIf Mth = 8 Then
     Sheets("sheet1").Range("F22:F25").Value = MyArr
     ElseIf Mth = 9 Then
     Sheets("sheet1").Range("G22:G25").Value = MyArr
     ElseIf Mth = 10 Then
     Sheets("sheet1").Range("H22:H25").Value = MyArr
     ElseIf Mth = 11 Then
     Sheets("sheet1").Range("I22:I25").Value = MyArr
     Else
     MsgBox ("Error")
     End If
    End Sub
    '---

    [EDIT - added  R2 version} - it is a little shorter...
    Sub MthlyFuelUtilityR2()
     Dim Mth As Integer
     Dim MyArr As Variant
     
     With Sheets("sheet2")
      Mth = VBA.Month(.Range("d23").Value)
      MyArr = Array(.Range("E33").Value, .Range("E36").Value, .Range("E39").Value, .Range("E42").Value)
     End With
     MyArr = Application.WorksheetFunction.Transpose(MyArr)
     With Sheets("sheet1")
      Select Case Mth
       Case 7:   .Range("E22:E25").Value = MyArr
       Case 8:   .Range("F22:F25").Value = MyArr
       Case 9:   .Range("G22:G25").Value = MyArr
       Case 10:  .Range("H22:H25").Value = MyArr
       Case 11:  .Range("I22:I25").Value = MyArr
       Case Else: MsgBox ("Month Error"), vbExclamation, "tuchellis"
      End Select
     End With
    End Sub
    '---

    Jim Cone
    Portland, Oregon USA
    https://goo.gl/IUQUN2 (Dropbox)
    (free & commercial excel add-ins & workbooks)

    • Edited by James Cone Thursday, August 17, 2017 11:55 PM Added revised version R2
    • Proposed as answer by Terry Xu - MSFT Friday, August 18, 2017 5:43 AM
    Thursday, August 17, 2017 8:44 PM
  • You can use a little more logic to make the code more flexible:

    Sub MthlyFuelUtility()
        Dim Mth As Integer
        Dim UF_Data As Worksheet
        Dim shtT As Worksheet
        
        Set UF_Data = Sheets("sheet2")
        Set shtT = Sheets("sheet1")
        
        Mth = Month(UF_Data.Range("D23").Value)
        
        If Mth >= 7 And Mth <= 12 Then
            shtT.Range("E22")(1, Mth - 6).Value = UF_Data.Range("E33").Value
            shtT.Range("E23")(1, Mth - 6).Value = UF_Data.Range("E36").Value
            shtT.Range("E24")(1, Mth - 6).Value = UF_Data.Range("E39").Value
            shtT.Range("E25")(1, Mth - 6).Value = UF_Data.Range("E42").Value
        Else
            MsgBox "Oops - wrong month!"
        End If
    End Sub


    Thursday, August 17, 2017 8:47 PM
  • Morning,

    Thanks a lot! Question, This works if you are going from July to December. I get an error message when I  put January. How do I incorporate January into the formula. I am going from data range July - June

    Please can you help me to understand what is happening here:

    (1, Mth - 6).

    Thanks!!!


    • Edited by tuchellis Friday, August 18, 2017 12:39 PM
    Friday, August 18, 2017 12:35 PM
  • Thanks everyone for the different methods. I ended up using Jim's method.
    Friday, August 18, 2017 2:10 PM
  •  How do I set it to get an error message if the month is outside the range of 1-12.

    I noticed that when I had the date as 21/1/2017, it returned 1.

    I want to return AN error message. It should be using MM/DD/..... not DD/MM

    Mth = VBA.Month(UF_Data.Range("d23").Value)

    Thanks!!!

    Friday, August 18, 2017 2:16 PM
  • Mth = VBA.Month(UF_Data.Range("D23").Value)
    If Mth > 12 Or Mth < 1 Then
    Msgbox "you dummy"
    Exit Sub
    End If

    • Marked as answer by tuchellis Monday, September 11, 2017 2:18 PM
    Friday, August 18, 2017 4:09 PM
  • Just for completeness:

    Get rid of the IF (  If Mth >= 7 And Mth <= 12 Then) Else, <g class="gr_ gr_113 gr-alert gr_spell gr_inline_cards gr_run_anim ContextualSpelling ins-del" data-gr-id="113" id="113">Msgbox</g>, and End If and use this:

            shtT.Range("E22")(1, IIF(Mth>6,Mth - 6,Mth+ 6)).Value = UF_Data.Range("E33").Value
            shtT.Range("E23")(1, IF(Mth>6,Mth - 6,Mth+ 6)).Value = UF_Data.Range("E36").Value
            shtT.Range("E24")(1, IF(Mth>6,Mth - 6,Mth+ 6)).Value = UF_Data.Range("E39").Value
            shtT.Range("E25")(1, IF(Mth>6,Mth - 6,Mth+ 6)).Value = UF_Data.Range("E42").Value

    • Marked as answer by tuchellis Monday, September 11, 2017 2:18 PM
    Saturday, August 19, 2017 4:16 AM