Merge 2 VB codes and add Application.screenupdating

[redspanna]

Hi all

I have two long bits of code that carries out similar functions
I've tried myself (without obvious success) to merge them into ONE CODE

Can this be done with these two codes

code 1:

Sub CopyEbayData()
  
  
    
    Dim sourceWorkbook As Workbook
    Dim targetWorkbook As Workbook
    Dim sourceWorksheet As Worksheet
    Dim copiedWorksheet As Worksheet
   
   
    ' Set the source workbook (workbook with "ebay-listings" in its name)
    Set sourceWorkbook = GetWorkbookWithMatchingName("ebay-Listings")
    
    ' Check if the source workbook was found
    If Not sourceWorkbook Is Nothing Then
        ' Set the source worksheet (the only worksheet in the source workbook)
        Set sourceWorksheet = sourceWorkbook.Worksheets(1)
        
        ' Set the target workbook (workbook named "Sales4")
        Set targetWorkbook = ThisWorkbook ' Assuming this code is in the Sales4 workbook
        
        ' Copy the source worksheet to the target workbook
        sourceWorksheet.Copy After:=targetWorkbook.Sheets(targetWorkbook.Sheets.Count)
        
        ' Set the copied worksheet object reference
        Set copiedWorksheet = targetWorkbook.Sheets(targetWorkbook.Sheets.Count)
        
        ' Rename the copied worksheet to "ebay"
        copiedWorksheet.Name = "ebay"
        
           
        ' Clean up
        Set sourceWorksheet = Nothing
        sourceWorkbook.Close False ' Close the source workbook without saving changes
        Set sourceWorkbook = Nothing
        
        'run code to add VLOOKUP formula
        If_string_match_found_place_formula
        'run code to change neagative numbers to positive
        ChangeNegativeValues
        
       
        
    Else
        MsgBox "Source workbook not found."
    End If
End Sub

Function GetWorkbookWithMatchingName(ByVal partialName As String) As Workbook


  
    Dim wb As Workbook
    
    For Each wb In Workbooks
        If InStr(1, wb.Name, partialName, vbTextCompare) = 1 Then
            ' Found a workbook with a matching name
            Set GetWorkbookWithMatchingName = wb
            Exit Function
        End If
    Next wb
    
    ' No matching workbook found
    Set GetWorkbookWithMatchingName = Nothing
    
      
End Function


Sub If_string_match_found_place_formula()



  Dim c As Range, f As Range
  Dim sh1 As Worksheet
  Set sh1 = Sheets("Stock")
  For Each c In sh1.Range("B3", sh1.Range("B" & Rows.Count).End(3))
    Set f = Sheets("ebay").Range("A:A").Find(c.Value, , xlValues, xlWhole, , , False)
    If Not f Is Nothing Then
      sh1.Range("H" & c.Row).Formula = "=VLOOKUP(B" & c.Row & ",ebay!A1:BA" & f.Row & ",8,0)"
      sh1.Range("I" & c.Row).Formula = "=VLOOKUP(B" & c.Row & ",ebay!A1:BA" & f.Row & ",10,0)"
      sh1.Range("k" & c.Row).Formula = "=VLOOKUP(B" & c.Row & ",ebay!A1:BA" & f.Row & ",17,0)"
      sh1.Range("O" & c.Row).Value = "eBay"
      sh1.Range("M" & c.Row).Formula = "=VLOOKUP(B" & c.Row & ",ebay!A1:BA" & f.Row & ",5,0)"
      sh1.Range("N" & c.Row).Formula = "=VLOOKUP(B" & c.Row & ",ebay!A1:BA" & f.Row & ",4,0)"
    End If
    

  Next
 
End Sub

Sub ChangeNegativeValues()

    Dim ws As Worksheet
    Dim rng As Range
    Dim cell As Range
    
    ' Set the worksheet where the data is located
    Set ws = ThisWorkbook.Sheets("Stock") 
    
    ' Set the range of columns H to K
    Set rng = ws.Range("H3:K3000")
    
    ' Loop through each cell in the range
    For Each cell In rng
        ' Check if the value is negative
        If cell.Value < 0 Then
            ' Change the negative value to its positive equivalent
            cell.Value = Abs(cell.Value)
        End If
    Next cell
    
      

     CopyEbayData2
      
    
    
End Sub

code 2:

Sub CopyEbayData2()


  
    Dim sourceWorkbook As Workbook
    Dim targetWorkbook As Workbook
    Dim sourceWorksheet As Worksheet
    Dim copiedWorksheet As Worksheet
    
    ' Set the source workbook (workbook with "ebay-orders" in its name)
    Set sourceWorkbook = GetWorkbookWithMatchingName("ebay-orders")
    
    ' Check if the source workbook was found
    If Not sourceWorkbook Is Nothing Then
        ' Set the source worksheet (the only worksheet in the source workbook)
        Set sourceWorksheet = sourceWorkbook.Worksheets(1)
        
        ' Set the target workbook (workbook named "Sales4")
        Set targetWorkbook = ThisWorkbook ' Assuming this code is in the Sales4 workbook
        
        ' Copy the source worksheet to the target workbook
        sourceWorksheet.Copy After:=targetWorkbook.Sheets(targetWorkbook.Sheets.Count)
        
        ' Set the copied worksheet object reference
        Set copiedWorksheet = targetWorkbook.Sheets(targetWorkbook.Sheets.Count)
        
        ' Rename the copied worksheet to "ebay"
        copiedWorksheet.Name = "ebay2"
        
    
      
        ' Clean up
        Set sourceWorksheet = Nothing
        sourceWorkbook.Close False ' Close the source workbook without saving changes
        Set sourceWorkbook = Nothing
        
        'run code to add VLOOKUP formula
        If_string_match_found_place_formula2
        'run code to change neagative numbers to positive
        ChangeNegativeValues
        

        
    Else
        'MsgBox "Source workbook not found."
    End If
      
End Sub

Function GetWorkbookWithMatchingName(ByVal partialName As String) As Workbook
    Dim wb As Workbook
    
    For Each wb In Workbooks
        If InStr(1, wb.Name, partialName, vbTextCompare) = 1 Then
            ' Found a workbook with a matching name
            Set GetWorkbookWithMatchingName = wb
            Exit Function
        End If
    Next wb
    
    ' No matching workbook found
    Set GetWorkbookWithMatchingName = Nothing
End Function


Sub If_string_match_found_place_formula2()

  Dim c As Range, f As Range
  Dim sh1 As Worksheet
  Set sh1 = Sheets("Stock")
  For Each c In sh1.Range("B3", sh1.Range("B" & Rows.Count).End(3))
    Set f = Sheets("ebay2").Range("x:x").Find(c.Value, , xlValues, xlWhole, , , False)
    If Not f Is Nothing Then
     
      sh1.Range("L" & c.Row).Formula = "=VLOOKUP(B" & c.Row & ",ebay2!X1:BA" & f.Row & ",27,0)"
     
    End If
  Next

End Sub

Sub ChangeNegativeValues2()

    Dim ws As Worksheet
    Dim rng As Range
    Dim cell As Range
    
    ' Set the worksheet where the data is located
    Set ws = ThisWorkbook.Sheets("Stock")
    
    ' Set the range of columns H to K
    Set rng = ws.Range("H3:K3000")
    
    ' Loop through each cell in the range
    For Each cell In rng
        ' Check if the value is negative
        If cell.Value < 0 Then
            ' Change the negative value to its positive equivalent
            cell.Value = Abs(cell.Value)
        End If
    Next cell
  
    MsgBox "Data copied"
    
End Sub

once this is done can a Application.Screenupdating = True & Application.Screenupdating = False also be added so that no updating is seen when code running

many thanks in advance

 

[Micron]

Generally speaking, you'd write one procedure that takes as many parameters as required. As an example, if there are 3 common parameters required in both subs and the other requires 2 additional but different ones, then the one procedure needs 5 parameters: 3 required and 2 optional. That way you can run it for job A and pass 3 parameter values and then run for job B and pass the same 3 plus the additional 2. As you go through the code, you test if an applicable parameter value was passed and code for that test. Such a test could be used to dictate that you either execute your 5 VLookups for ebay2 or just 1 for ebay.

 

[Bosquedeguate]

You might download a code comparison application (or maybe there is a website that does this). This kind of code will give you a line by line comparison (trying to match lines that are the same) and will show you the differences.

Then it is up to you to decide which of your two files will become the code for both.

You will have do Export the VBA code from both of your Execl files to do the comparison.

I used the "fc" (file compare) app in Windows to produce a comparison of your two VBA code sets above:

Here is a link to the comparison results.
comparison.txt

Sample output from FC app:
Comparing files File1.txt and FILE2.TXT
***** File1.txt
Sub CopyEbayData()


Dim sourceWorkbook As Workbook
***** FILE2.TXT
Sub CopyEbayData2()

Dim sourceWorkbook As Workbook
*****

***** File1.txt
Dim copiedWorksheet As Worksheet


' Set the source workbook (workbook with "ebay-listings" in its name)
Set sourceWorkbook = GetWorkbookWithMatchingName("ebay-Listings")

***** FILE2.TXT
Dim copiedWorksheet As Worksheet

' Set the source workbook (workbook with "ebay-orders" in its name)
Set sourceWorkbook = GetWorkbookWithMatchingName("ebay-orders")

*****

***** File1.txt
' Rename the copied worksheet to "ebay"
copiedWorksheet.Name = "ebay"


' Clean up
***** FILE2.TXT
' Rename the copied worksheet to "ebay"
copiedWorksheet.Name = "ebay2"