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)
endTry:
Next i
SrcWb.Close
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)
fromRange.Copy
toRange.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.StatusBar = "Copying In progress..." & Round(completed, 0) & "% completed"
DoEvents
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.