join models

[Paul_Hossler]

I'd open the 'database' workbook, copy the From/To worksheet into the Input workbook, do the replaces, and then delete the 'database' sheet

I think it's cleaner and less confusing that way


This code is in the 'Input' workbook, and the 'database' workbook has no macros so it's a XLSX

Option Explicit

Sub Replaces()
    Dim wbData As Workbook
    
    Application.ScreenUpdating = False
    
    'delete Data is if still exists
    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets("Data").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    
    'open Replaces workbook and copy data sheet in
    Workbooks.Open Filename:=Environ("USERPROFILE") & "\Desktop\ReplaceData.xlsx"   '   <<<<<<<<<<<<<<<<<
    Set wbData = ActiveWorkbook
    wbData.Worksheets("Data").Copy Before:=ThisWorkbook.Worksheets(1)
    wbData.Close False
    
    ThisWorkbook.Activate
    
    'do the replaces
    Call ReplaceAllSheets(Worksheets("Data").Range("A1"))
    Call ReplaceAllSheets(Worksheets("Data").Range("D1"))
    Call ReplaceAllSheets(Worksheets("Data").Range("G1"))
    'get rid of Data
    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets("Data").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    
    Application.ScreenUpdating = True
End Sub


'this sub is Private so that it's only usable in this module
Private Sub ReplaceAllSheets(R As Range)
    Dim i As Long
    Dim ws As Worksheet
    Dim r1 As Range
    
    Set r1 = R.CurrentRegion
    
    If r1.Rows.Count < 2 Then Exit Sub
    
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name = "Data" Then GoTo GetNextSheet
        If ws.UsedRange.Cells.Count < 2 Then GoTo GetNextSheet
        
        For i = 2 To r1.Rows.Count
            ws.UsedRange.Cells.Replace What:=r1.Cells(i, 1).Value, Replacement:=r1.Cells(i, 2).Value, _
                LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
                SearchFormat:=False, ReplaceFormat:=False
        Next i
GetNextSheet:
    Next
End Sub