VBA - Shorten existing code request

N

Nordicrx8

Board Regular
Joined
Dec 10, 2015
Messages
143
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

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
Sort by date Sort by votes
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
johnnyL said:
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
Click to expand...
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
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
johnnyL said:
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.
Click to expand...
Makes sense - thanks again! :)
 
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Question
VBA - Search workbook tabs for a match, then paste data
Replies
4
Views
876
Gokhan Aycan
Gokhan Aycan
N
  • Solved
VBA: Find Open Workbook, Find Tab Name, and Paste Data
2
Replies
17
Views
2K
Nordicrx8
N
J
  • Question
Modify VBA to Exclude Dates Prior to Today
Replies
0
Views
249
Justinian
J
B
  • Locked
  • Question
Find and Replace WB references (VBA)
Replies
7
Views
628
RoryA
RoryA
G
  • Question
Copying and pasting between two workbooks
Replies
1
Views
492
rlv01
R

Forum statistics

Threads
1,214,530
Messages
6,120,071
Members
448,943
Latest member
sharmarick

Share this page

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