PDA

View Full Version : Avoid code repetition by calling the common code from another sub



shettyrish
01-25-2018, 03:46 AM
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

snb
01-25-2018, 05:40 AM
Why don't you use Code tags ?

shettyrish
01-25-2018, 05:55 AM
I am new to this forum, how exactly do I use code tags?

snb
01-25-2018, 06:04 AM
You have 11 posts, so you are not new.

georgiboy
01-25-2018, 06:22 AM
On the header of the reply/quick reply box there is a symbol of a #

Click that and then paste your code in-between the two sets of box brackets that are around the word code

The code will now be far more aesthetically pleasing

One last thing: When i wanted to get help on forums in the past i have always found it better to recreate the issue you are having in a simple sub routine and then paste that to the forum. This way you can write a short description of the issue and are more likely to get help.
The benefit of this is you can then fully gain an understanding of the offered solution and apply it to your code with your newfound knowledge.

Hope this helps

SamT
01-25-2018, 08:18 AM
Sub MsgAnswer is a mess that can not work

Paul_Hossler
01-25-2018, 08:31 AM
It would probably be better to post a small workbook with all the code the way you have it

That way it'd be easier for other to see the entire flow