Avoid code repetition by calling common code from another sub

  • I have a code that has an If-else condition in which only the first few lines of each condition differ, the rest of the operation is the same for both. The following is my common code which I have placed in a sub named 'MsgAnswer' :

    Sub MsgAnswer(SrcWb As Workbook, DestSheet As Worksheet, SrcSheet As Worksheet)

    completed = 0
    Application.StatusBar = "Copying In progress..." & Round(completed, 0) & "% completed"

    'Find the last non-blank cell in row ref
    lnCol = SrcWb.Sheets(SourceName).Cells(ref, Columns.Count).End(xlToLeft).Column

    last = lnCol - 1 'To get penultimate column

    Set DestSheet = DestWb.Sheets(DestName)
    Set SrcSheet = SrcWb.Sheets(SourceName)

    destTotalRows = DestSheet.Cells(Rows.Count, 1).End(xlUp).Row 'Finding last non-blank cell in Column 1 in Destination sheet
    MsgBox "Last row is: " & destTotalRows

    For i = 1 To destTotalRows

    destKey = DestSheet.Cells(i, 1)
    If destKey = "" Then GoTo endTry 'Ignoring blanks while looping through destination sheet

    sourceKey = GetSourceKey(destKey)
    If sourceKey = "" Then GoTo endTry 'Ignoring unmatched values while looping through source sheet

    Debug.Print "DestKey", destKey, "SourceKey", sourceKey

    k = DestSheet.Cells(1, 1).EntireColumn.Find(What:=destKey, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Row 'Finding row with Destkey in Destination sheet
    j = SrcSheet.Cells(1, 2).EntireColumn.Find(What:=sourceKey, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Row 'Finding row with Srckey in Source sheet

    Debug.Print j, k

    Call CopyRange(SrcSheet.Range(Cells(j, 3), Cells(j, 3).End(xlToRight)), DestSheet.Cells(k, 2), completed) 'Copying the data from Source sheet and pasting it onto destiation sheet
    completed = completed + (100 / steps)
    Next i


    End Sub
    This is my uncommon code :
    1) If answer = vbYes Then
    MyFile = Application.GetOpenFilename(FileFilter:="Excel Files,*.xl*;*.xm*")

    2) ElseIf answer = vbNo Then

    'change the address to suit
    MyFile = Dir(MyDir & "Estimate*.xls*")
    ChDir MyDir

    Set SrcWb = Workbooks.Open(MyDir + MyFile, UpdateLinks:=0)

    The code before the If-else condition :

    Sub CopyRange(fromRange As Range, toRange As Range, completed As Double)
    toRange.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    Application.StatusBar = "Copying In progress..." & Round(completed, 0) & "% completed"
    End Sub

    Sub Automate_Estimate()

    Dim MyFile As String, Str As String, MyDir As String, DestWb As Workbook, SrcWb As Workbook
    Dim Rws As Long, Rng As Range
    Dim DestName As String
    Dim SourceName As String
    Dim completed As Double
    Dim flg As Boolean, sh As Worksheet
    Dim ref As Long
    'Dim DestRowCount As Long
    Dim DestColCount As Long
    Dim lnCol As Long
    Dim last As Long
    Dim destKey As String, sourceKey As String
    Dim destTotalRows As Long
    Dim i As Integer, j, k As Integer
    Dim DestSheet As Worksheet
    Dim SrcSheet As Worksheet

    DestName = "x" 'Name of destination sheet
    SourceName = "y" 'Name of Source sheet
    MyDir = "\Path" 'Default directory path"
    Const steps = 22 'Number of rows copied
    ref = 13 'row in Estimate sheet in which 'Grand Total' is present
    Set DestWb = ThisWorkbook 'Setting Destination workbook

    ' disable certain excel features to speed up the process

    Application.DisplayAlerts = False
    'Application.EnableEvents = False
    ActiveSheet.DisplayPageBreaks = False
    Application.Calculation = xlCalculationManual


    I get an error in my 'MsgAnswer' sub when I call it within If using 'Call MsgAnswer(SrcWb, DestSheet, SrcSheet)' . The error is "ByRef Argument mismatch" and it shows error in the 'for loop' in 'sourceKey = GetSourceKey(destKey)', where GetSourceKey is another function. Any help would be appreciated. Thank you.

  • I told you only yesterday about cross posting (as well as not using code tags) and here you are again. I am closing this thread until you PM me acknowledging my post and agreeing to add links.

Participate now!

Don’t have an account yet? Register yourself now and be a part of our community!