VBA - Shorten existing code request

Nordicrx8

Board Regular
Joined
Dec 10, 2015
Messages
120
Office Version
  1. 365
Platform
  1. Windows
Hi all!

Below is code that works, but I'm sure there is a way to shorten/simplify it. It's basically the same code over and over again for each line I'm copying over. Any thoughts on how to accomplish the same thing with less code?

Thanks so much!

VBA Code:
Sub Monthly_CP()
Dim wb1 As Workbook
Dim fm
With Workbooks("SLMR Master - All Regions").Sheets("Main")
    Set wb1 = Workbooks("Service Level Miss " & .Range("k2") & " MTD " & .Range("e2"))
   
                fm = Application.Match(.Range("E14"), wb1.Sheets("MTD performance").Range("A4:A40"), 0)
        If IsNumeric(fm) Then
            wb1.Sheets("MTD Performance").Range("B" & fm + 3 & ":C" & fm + 3).Value = .Range("F14:G14").Value
        End If
                fm = Application.Match(.Range("E17"), wb1.Sheets("MTD performance").Range("A4:A40"), 0)
        If IsNumeric(fm) Then
            wb1.Sheets("MTD Performance").Range("B" & fm + 3).Value = .Range("F17").Value
        End If
                 fm = Application.Match(.Range("I19"), wb1.Sheets("MTD performance").Range("A4:A40"), 0)
        If IsNumeric(fm) Then
            wb1.Sheets("MTD Performance").Range("B" & fm + 3 & ":C" & fm + 3).Value = .Range("F19:G38").Value
        End If
          fm = Application.Match(.Range("I20"), wb1.Sheets("MTD performance").Range("A4:A40"), 0)
        If IsNumeric(fm) Then
            wb1.Sheets("MTD Performance").Range("B" & fm + 3 & ":C" & fm + 3).Value = .Range("F20:G20").Value
        End If
          fm = Application.Match(.Range("I21"), wb1.Sheets("MTD performance").Range("A4:A40"), 0)
        If IsNumeric(fm) Then
            wb1.Sheets("MTD Performance").Range("B" & fm + 3 & ":C" & fm + 3).Value = .Range("F21:G21").Value
        End If
          fm = Application.Match(.Range("I22"), wb1.Sheets("MTD performance").Range("A4:A40"), 0)
        If IsNumeric(fm) Then
            wb1.Sheets("MTD Performance").Range("B" & fm + 3 & ":C" & fm + 3).Value = .Range("F22:G22").Value
        End If
          fm = Application.Match(.Range("I23"), wb1.Sheets("MTD performance").Range("A4:A40"), 0)
        If IsNumeric(fm) Then
            wb1.Sheets("MTD Performance").Range("B" & fm + 3 & ":C" & fm + 3).Value = .Range("F23:G23").Value
        End If
          fm = Application.Match(.Range("I24"), wb1.Sheets("MTD performance").Range("A4:A40"), 0)
        If IsNumeric(fm) Then
            wb1.Sheets("MTD Performance").Range("B" & fm + 3 & ":C" & fm + 3).Value = .Range("F24:G24").Value
        End If
          fm = Application.Match(.Range("I26"), wb1.Sheets("MTD performance").Range("A4:A40"), 0)
        If IsNumeric(fm) Then
            wb1.Sheets("MTD Performance").Range("B" & fm + 3 & ":C" & fm + 3).Value = .Range("F26:G26").Value
        End If
          fm = Application.Match(.Range("I27"), wb1.Sheets("MTD performance").Range("A4:A40"), 0)
        If IsNumeric(fm) Then
            wb1.Sheets("MTD Performance").Range("B" & fm + 3 & ":C" & fm + 3).Value = .Range("F27:G27").Value
        End If
          fm = Application.Match(.Range("I28"), wb1.Sheets("MTD performance").Range("A4:A40"), 0)
        If IsNumeric(fm) Then
            wb1.Sheets("MTD Performance").Range("B" & fm + 3 & ":C" & fm + 3).Value = .Range("F28:G28").Value
        End If
          fm = Application.Match(.Range("I29"), wb1.Sheets("MTD performance").Range("A4:A40"), 0)
        If IsNumeric(fm) Then
            wb1.Sheets("MTD Performance").Range("B" & fm + 3 & ":C" & fm + 3).Value = .Range("F29:G29").Value
        End If
          fm = Application.Match(.Range("I30"), wb1.Sheets("MTD performance").Range("A4:A40"), 0)
        If IsNumeric(fm) Then
            wb1.Sheets("MTD Performance").Range("B" & fm + 3 & ":C" & fm + 3).Value = .Range("F30:G30").Value
        End If
          fm = Application.Match(.Range("I32"), wb1.Sheets("MTD performance").Range("A4:A40"), 0)
        If IsNumeric(fm) Then
            wb1.Sheets("MTD Performance").Range("B" & fm + 3 & ":C" & fm + 3).Value = .Range("F32:G32").Value
        End If
          fm = Application.Match(.Range("I33"), wb1.Sheets("MTD performance").Range("A4:A40"), 0)
        If IsNumeric(fm) Then
            wb1.Sheets("MTD Performance").Range("B" & fm + 3 & ":C" & fm + 3).Value = .Range("F33:G33").Value
        End If
                  fm = Application.Match(.Range("I34"), wb1.Sheets("MTD performance").Range("A4:A40"), 0)
        If IsNumeric(fm) Then
            wb1.Sheets("MTD Performance").Range("B" & fm + 3 & ":C" & fm + 3).Value = .Range("F34:G34").Value
        End If
                  fm = Application.Match(.Range("I36"), wb1.Sheets("MTD performance").Range("A4:A40"), 0)
        If IsNumeric(fm) Then
            wb1.Sheets("MTD Performance").Range("B" & fm + 3 & ":C" & fm + 3).Value = .Range("F36:G36").Value
        End If
                  fm = Application.Match(.Range("I37"), wb1.Sheets("MTD performance").Range("A4:A40"), 0)
        If IsNumeric(fm) Then
            wb1.Sheets("MTD Performance").Range("B" & fm + 3 & ":C" & fm + 3).Value = .Range("F37:G37").Value
        End If
                  fm = Application.Match(.Range("I38"), wb1.Sheets("MTD performance").Range("A4:A40"), 0)
        If IsNumeric(fm) Then
            wb1.Sheets("MTD Performance").Range("B" & fm + 3 & ":C" & fm + 3).Value = .Range("F38:G38").Value
        End If
End With

End Sub
 

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
4,091
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
Shortened up a bit:

VBA Code:
Sub Monthly_CP()
'
    Dim LoopCounter As Long
    Dim wb1         As Workbook
    Dim fm
'
    With Workbooks("SLMR Master - All Regions").Sheets("Main")
        Set wb1 = Workbooks("Service Level Miss " & .Range("k2") & " MTD " & .Range("e2"))
'
        fm = Application.Match(.Range("E14"), wb1.Sheets("MTD performance").Range("A4:A40"), 0)
        If IsNumeric(fm) Then wb1.Sheets("MTD Performance").Range("B" & fm + 3 & ":C" & fm + 3).Value = .Range("F14:G14").Value
'
        fm = Application.Match(.Range("E17"), wb1.Sheets("MTD performance").Range("A4:A40"), 0)
        If IsNumeric(fm) Then wb1.Sheets("MTD Performance").Range("B" & fm + 3).Value = .Range("F17").Value '<---This line is not like the others ???
'
        fm = Application.Match(.Range("I19"), wb1.Sheets("MTD performance").Range("A4:A40"), 0)
        If IsNumeric(fm) Then wb1.Sheets("MTD Performance").Range("B" & fm + 3 & ":C" & fm + 3).Value = .Range("F19:G38").Value
'
        For LoopCounter = 20 To 38
            fm = Application.Match(.Range("I" & LoopCounter), wb1.Sheets("MTD performance").Range("A4:A40"), 0)
            If IsNumeric(fm) Then wb1.Sheets("MTD Performance").Range("B" & fm + 3 & ":C" & fm + 3).Value = .Range("F" & LoopCounter & ":G" & LoopCounter).Value
            If LoopCounter = 24 Then LoopCounter = LoopCounter + 1
            If LoopCounter = 30 Then LoopCounter = LoopCounter + 1
            If LoopCounter = 34 Then LoopCounter = LoopCounter + 1
        Next
    End With
End Sub
 
Upvote 0
Solution

Nordicrx8

Board Regular
Joined
Dec 10, 2015
Messages
120
Office Version
  1. 365
Platform
  1. Windows
Shortened up a bit:

VBA Code:
Sub Monthly_CP()
'
    Dim LoopCounter As Long
    Dim wb1         As Workbook
    Dim fm
'
    With Workbooks("SLMR Master - All Regions").Sheets("Main")
        Set wb1 = Workbooks("Service Level Miss " & .Range("k2") & " MTD " & .Range("e2"))
'
        fm = Application.Match(.Range("E14"), wb1.Sheets("MTD performance").Range("A4:A40"), 0)
        If IsNumeric(fm) Then wb1.Sheets("MTD Performance").Range("B" & fm + 3 & ":C" & fm + 3).Value = .Range("F14:G14").Value
'
        fm = Application.Match(.Range("E17"), wb1.Sheets("MTD performance").Range("A4:A40"), 0)
        If IsNumeric(fm) Then wb1.Sheets("MTD Performance").Range("B" & fm + 3).Value = .Range("F17").Value '<---This line is not like the others ???
'
        fm = Application.Match(.Range("I19"), wb1.Sheets("MTD performance").Range("A4:A40"), 0)
        If IsNumeric(fm) Then wb1.Sheets("MTD Performance").Range("B" & fm + 3 & ":C" & fm + 3).Value = .Range("F19:G38").Value
'
        For LoopCounter = 20 To 38
            fm = Application.Match(.Range("I" & LoopCounter), wb1.Sheets("MTD performance").Range("A4:A40"), 0)
            If IsNumeric(fm) Then wb1.Sheets("MTD Performance").Range("B" & fm + 3 & ":C" & fm + 3).Value = .Range("F" & LoopCounter & ":G" & LoopCounter).Value
            If LoopCounter = 24 Then LoopCounter = LoopCounter + 1
            If LoopCounter = 30 Then LoopCounter = LoopCounter + 1
            If LoopCounter = 34 Then LoopCounter = LoopCounter + 1
        Next
    End With
End Sub
This worked perfectly - thank you! Sorry for the delay in my response, I was on vacation due to the holiday and just had a chance to try it out now.

If you have some time, could you explain the changes you made and how it works? I'm still very much a novice, but I like to learn as much as possible.

Thanks again! :)
 
Upvote 0

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
4,091
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
As you originally stated, the lines of code are practically all the same.

The addresses were just a little different. So I used a variable (LoopCounter) in the addresses that can be incremented to reflect the different addresses.

When the similar lines of repeated code are put into the For/Next loop, the looping increments the LoopCounter and thus the addresses.

Use of the loop removes the necessity of writing the same lines of code over and over.
 
Upvote 0

Nordicrx8

Board Regular
Joined
Dec 10, 2015
Messages
120
Office Version
  1. 365
Platform
  1. Windows
As you originally stated, the lines of code are practically all the same.

The addresses were just a little different. So I used a variable (LoopCounter) in the addresses that can be incremented to reflect the different addresses.

When the similar lines of repeated code are put into the For/Next loop, the looping increments the LoopCounter and thus the addresses.

Use of the loop removes the necessity of writing the same lines of code over and over.
Makes sense - thanks again! :)
 
Upvote 0

Forum statistics

Threads
1,186,330
Messages
5,957,251
Members
438,295
Latest member
nm005

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
Top