join models

Hi All

I have 9 VBA Modules I am trying to join. I have alreadyjoined a bunch and it is working but I have one that has a “Private Function”state meant after it and it is not working out the same. Can anyone help mewith joining these.
Currently I have a module I call runall. Then it just callsall of them. But when I will need to load this on other computers it willrequire me to import all 9 modules. Would be easier if it is all in one.


When I joined others, I just removed the DIM statements andthe End Sub and they worked. Below I put some of the ones I need joined. It isthe negative module with the private function it keeps stopping at.
Thanks

------------------------------------------------------------------------------------------------------------------------------------------


Sub RenameActivesheet1()
ActiveSheet.Name ="Input"
End Sub

------------------------------------------------------------------------------------------------------------------------------------------


Sub addClassReturns()
Dim sht As Worksheet
Dim Where As Range
For Each sht InWorksheets
With sht
Set Where =.Range("C" & .Rows.Count).End(xlUp)
Set Where =.Range("J1", .Range("J" & Where.Row))
End With
Withsht.Range("J1")
.FormulaR1C1 = _
"=IF(LEFT(RC[-7],1)=""1"",""2 RouteReturns"", IF(LEFT(RC[-7],1)=""5"",""2Route Returns"",IF(LEFT(RC[-7],1)=""4"",""2Route Returns"", """")))"
IfWhere.Rows.Count > 1 Then
.AutoFillDestination:=Where, Type:=xlFillDefault
End If
End With
Next
End Sub


------------------------------------------------------------------------------------------------------------------------------------------

Sub Negative()
Dim Ws As Worksheet
Dim Where As Range,This As Range
For Each Ws InWorksheets
Set Where =SpecialCells(Ws.UsedRange, xlCellTypeConstants, xlNumbers)
If Not Where IsNothing Then
For Each This InWhere
If This < 0Then This = Abs(This)
Next
End If
Next
End Sub

Private Function SpecialCells(ByVal r As Range, ByVal Typ AsXlCellType, _
Optional ByValValue As XlSpecialCellsValue = &H17) As Range
'Avoid theSpecialCells-BUG to return all cells from the current region
On Error Resume Next
Select Case Typ
CasexlCellTypeConstants, xlCellTypeFormulas
Set SpecialCells= Intersect(r, r.SpecialCells(Typ, Value))
CasexlCellTypeConstants Or xlCellTypeFormulas
'Specialfeature: Return all used cells
Set SpecialCells= Intersect(r, r.SpecialCells(xlCellTypeConstants, Value))
If SpecialCellsIs Nothing Then
SetSpecialCells = Intersect(r, r.SpecialCells(xlCellTypeFormulas, Value))
Else
SetSpecialCells = Union(SpecialCells, Intersect(r,r.SpecialCells(xlCellTypeFormulas, Value)))
End If
Case Else
Set SpecialCells= Intersect(r, r.SpecialCells(Typ))
End Select
End Function


------------------------------------------------------------------------------------------------------------------------------------------


Sub Template()
Dim DataJ, DataK
Dim Where As Range
Dim i As Long
Dim Ws As Worksheet

For Each Ws InWorksheets
With Ws
Set Where =.Range("J1", .Range("J" & .Rows.Count).End(xlUp))
End With
DataJ =Where.Value
DataK =Where.Offset(, 1).Value
If NotIsArray(DataJ) Then
ReDim DataJ(1 To1, 1 To 1)
DataJ(1, 1) =Where.Value
ReDim DataK(1 To1, 1 To 1)
DataK(1, 1) =Where.Offset(, 1).Value
End If

For i = 1 ToUBound(DataJ)
If NotIsError(DataJ(i, 1)) Then
Select CaseLeft$(Trim$(DataJ(i, 1)), 1)
Case"1"
DataK(i,1) = "Copy of: Intuit Service Invoice"
Case"2"
DataK(i,1) = "Custom Credit Memo"
End Select
End If
Next
Where.Offset(,1).Value = DataK
Next
End Sub







------------------------------------------------------------------------------------------------------------------------------------------

Option Explicit
Sub AddDiscountReturns()
Dim wbItem AsWorkbook
Dim wsInput AsWorksheet
Dim rData AsRange, rData1 As Range, rLast As Range, rTemp As Range
Dim iRow As Long,iItem As Long
Dim dDiscount AsDouble
Dim vItems AsVariant, vPrices As Variant

Application.ScreenUpdating = False

'get normal prices
Workbooks.Add"C:\midstate\item prices.xlsx" ' <<<<<<<<<<<<< change WB path
Set wbItem =ActiveWorkbook

Set rTemp =wbItem.Worksheets("Sheet1").Range("C1")
Set rTemp = Range(rTemp,rTemp.End(xlDown))
vItems =Application.WorksheetFunction.Transpose(rTemp)
Set rTemp =wbItem.Worksheets("Sheet1").Range("E1")
Set rTemp =Range(rTemp, rTemp.End(xlDown))
vPrices =Application.WorksheetFunction.Transpose(rTemp)

wbItem.Close False


'set data
Set wsInput =Worksheets("Input") ' <<<<< Change WSname
Set rLast =wsInput.Cells(1, wsInput.Columns.Count).End(xlToLeft)
Set rData =Range(wsInput.Cells(1, 1), rLast).EntireColumn
Set rData =Intersect(rData, wsInput.Cells(1, 1).CurrentRegion.EntireRow)
Set rData1 =rData.Cells(2, 1).Resize(rData.Rows.Count - 1, rData.Columns.Count)


'add Normal Prices
With wsInput
.Cells(1,8).Value = "Discount Price"
.Cells(1,9).Value = "line class"
For iRow = 2To rData.Rows.Count
iItem = 0
On ErrorResume Next
iItem =Application.WorksheetFunction.Match(.Cells(iRow, 4).Value, vItems, 0)
On ErrorGoTo 0

If iItem> 0 Then .Cells(iRow, 7).Value = vPrices(iItem)
Next iRow
End With


'sort by invoicedata and invoice number
With wsInput.Sort
.SortFields.Clear
.SortFields.Add Key:=rData1.Columns(1), SortOn:=xlSortOnValues,Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add2 Key:=rData1.Columns(2), SortOn:=xlSortOnValues,Order:=xlAscending, DataOption:=xlSortNormal
.SetRangerData
.Header =xlYes
.MatchCase =False
.Orientation =xlTopToBottom
.SortMethod =xlPinYin
.Apply
End With


'go up and add"20 Sales & Discount" to col D after invoice change
With wsInput
For iRow =rData.Rows.Count To 2 Step -1
If.Cells(iRow + 1, 2).Value <> .Cells(iRow, 2).Value Then
.Rows(iRow + 1).Insert
.Cells(iRow + 1, 4).Value = "20* Discounts"
.Cells(iRow + 1, 9).Value = "2.5 Sales Promotional Discount"
End If
Next iRow
End With


'go down and calcdiscount and fill in data
dDiscount = 0#
With wsInput
Set rData =.Cells(1, 1).CurrentRegion
For iRow = 2To rData.Rows.Count
IfLen(.Cells(iRow, 1).Value) > 0 Then
dDiscount = dDiscount + .Cells(iRow, 5).Value * (.Cells(iRow, 7).Value -.Cells(iRow, 6).Value)

Else
.Cells(iRow, 1).Value = .Cells(iRow - 1, 1).Value
.Cells(iRow, 2).Value = .Cells(iRow - 1, 2).Value
.Cells(iRow, 3).Value = .Cells(iRow - 1, 3).Value
.Cells(iRow, 8).Value = dDiscount
dDiscount = 0#
End If
Next iRow
End With


'cleanup
Application.ScreenUpdating = True
End Sub


------------------------------------------------------------------------------------------------------------------------------------------

Sub AddRow1()
WithWorksheets("Input")
.Range("A1").Value = "Invoice Date"
.Range("B1").Value = "Invoice Number"
.Range("C1").Value = "Account Name"
.Range("D1").Value = "Item"
.Range("E1").Value = "Qty"

.Range("H1").Value = "Discount Price"
.Range("I1").Value = "line class"
.Range("J1").Value = "class"
.Range("K1").Value = "template"
End With
End Sub

-----------------------------------------------------------------------------------------



I have attached all of the ones I need if anyone wants to help or just try to explain what I need to do with the private function. But I need them in order
Rename worksheet
Replace item returns
replaceCusName
budway
AddClassReturns
ConvertNegtoPos
AddTemplete
AddDiscountReturns
AddRowOne

Private Function just means that the scope of that function is only within that module, i.e. invisible to other modules. Online help has a good writeup

1. You have a lot of redundant code
2. Instead of hard coding the Find/Replace pairs in the macro, I'd make a little WS data base

Here's 2 versions of a Main sub. The first just calls your lower level modules, and the second using a FindReplace sub that uses the example database on the worksheet Data

Code:

---

Option Explicit
Sub Main()
    Application.ScreenUpdating = False
    'rename worksheet
    ActiveSheet.Name = "Input"
    Call Replace_Products_Returns
    Call Replace_cus_full
    Call Replace_Budwey
    Call addClassReturns
    Call Negative
    Call Template
    Call AddDiscountReturns
   
    With Worksheets("Input")
        .Range("A1").Value = "Invoice Date"
        .Range("B1").Value = "Invoice Number"
        .Range("C1").Value = "Account Name"
        .Range("D1").Value = "Item"
        .Range("E1").Value = "Qty"
       
        .Range("H1").Value = "Discount Price"
        .Range("I1").Value = "line class"
        .Range("J1").Value = "class"
        .Range("K1").Value = "template"
    End With
    Application.ScreenUpdating = True
End Sub

'using subs and a 'data base' on the sheet
Sub Main2()
    Dim wsData As Worksheet
    Application.ScreenUpdating = False
    'rename worksheet
    ActiveSheet.Name = "Input"
    Set wsData = Worksheets("Data")
    Call ReplaceAllSheets(ws.Range("A1"))  '  don't need mod_10_Replace_Product_Returns
    Call ReplaceAllSheets(ws.Range("D1"))  '  don't need mod_20_Replace_Customer_Full
    Call ReplaceAllSheets(ws.Range("G1"))  '  don't need mod_30_Replace_Budwey
   
    Call addClassReturns
    Call Negative
    Call Template
    Call AddDiscountReturns
   
    With Worksheets("Input")
        .Range("A1").Value = "Invoice Date"
        .Range("B1").Value = "Invoice Number"
        .Range("C1").Value = "Account Name"
        .Range("D1").Value = "Item"
        .Range("E1").Value = "Qty"
       
        .Range("H1").Value = "Discount Price"
        .Range("I1").Value = "line class"
        .Range("J1").Value = "class"
        .Range("K1").Value = "template"
    End With
    Application.ScreenUpdating = True
End Sub

---

I didn't do it but I'd add Option Private Module after the Option Explicit on each module EXCEPT for the Main one

That prevents the subs on in those modules from appearing in the publicly explosed Run Modules

Thanks

Having it look at the worksheet for the replace will help.When I need to add new stores it is a pain using the find and replace. The WSdatabase will be much better. I have one similar to replace the prices. I attached another module. It basically does the same thing just does not need the negative one. So I was just able to include them all into on module so I don’t need to import more than one module. I tried to do the same but it keepsfailing at the private function. So, I will look into what you mentioned but just to show you what I am trying to do.

Took a quick look

I'd suggest making things more modular

In my example, the Main sub calls the lower level subs and for clarity eacn lower level sub is on a separate sheet

The user just needs to run "Main" and it calls the others

Not sure about the rest you want to run, but look at this version

After I deleted the code that is in the other modules, mod_50_More has the remainder


Your main macro could look something like this

Code:

---

Option Explicit


Sub Main2()

    Dim wsData As Worksheet
    Dim bDoNegatives As Boolean

    'make sure we're on the right sheet
    If ActiveSheet.Name = "Data" Then
        Call MsgBox("Can't do it on the Data sheet. Pick another", vbCritical + vbOKOnly, "Format Macro")
        Exit Sub
    Else
        If MsgBox("Do you want to run the format macro on this sheet?", vbQuestion + vbYesNo, "Format Macro") = vbNo Then
            Exit Sub
        End If
    End If
   
    'see if we're going to do the negative numbers
    bDoNegatives = (MsgBox("Do you want to change the negative prices?", vbQuestion + vbYesNo, "Format Macro") = vbYes)

    'setup and init
    Application.ScreenUpdating = False
    ActiveSheet.Name = "Input"
    Set wsData = Worksheets("Data")

    Call ReplaceAllSheets(wsData.Range("A1"))
    Call ReplaceAllSheets(wsData.Range("D1"))
    Call ReplaceAllSheets(wsData.Range("G1"))
   
    Call addClassReturns
 
    If bDoNegatives Then Call Negative
   
    Call Template
    Call AddDiscountReturns
    Call More                      '  <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< the rest of the code mod_50
   
    'cleanup
    With Worksheets("Input")
        .Range("A1").Value = "Invoice Date"
        .Range("B1").Value = "Invoice Number"
        .Range("C1").Value = "Account Name"
        .Range("D1").Value = "Item"
        .Range("E1").Value = "Qty"
       
        .Range("H1").Value = "Discount Price"
        .Range("I1").Value = "line class"
        .Range("J1").Value = "class"
        .Range("K1").Value = "template"
    End With
    Application.ScreenUpdating = True
    Call MsgBox("Format macro completed", vbInformation + vbOKOnly, "Format Macro")

End Sub

---

Thank you. I will look into the code you have tomorrow. These are delivery sheets. Some are for the items we delivered and also for the returns. The one I attached in my last reply is a single module that will do all the conversions For the delivery sheet. The other one I need is for returns So my macro converts the negative numbers to positive numbers so I can import them into my accounting system. They need to be imported as positive numbers. Thank you for all the suggestions. I will look more tomorrow

The delivery item only requires me to import one file. The one included in my last reply For the return process I need to import many different files in order to run the main one.

For now I do have one. It does run “call” of them just by running one macro. But you need to import six different files so they are all there. That is for the returns. For the delivery items I was able to combine all of them into one. Where you only need to import one file and there is only one option to click run in the macro box I’m not sure if I’m making sense but I am using voice text from my phone. I will take a look tomorrow and clarify if I need. Again thanks

Should I start another post for this?

Hi

I have another macro I use to calculate the discount. This calls to a workbook “C:\midstate\itemprices.xlsx” to get the prices. “I put the top part of it below”.


How can I use the xlsm doc you provided “Products andstuff” if I put that in the same folder “C:\midstate\” to convert the storesand products. I Just want to create a macro to do just the find and replaceusing the way you showed me. I can use the other macros I have to do the other stuff.



I tried to play with the one you showed me but am notable to get it to work yet so just checking if you are around to help




This will make it so when I need to add need stores I donot need to adjust the find and replace one I am currently using. The is a painwhen I need to add new stores.






Sub AddDiscountReturns()
Dim wbItem As Workbook
Dim wsInput As Worksheet
Dim rData As Range, rData1 As Range, rLast As Range, rTemp As Range
Dim iRow As Long, iItem As Long
Dim dDiscount As Double
Dim vItems As Variant, vPrices As Variant
Application.ScreenUpdating = False
'get normal prices
Workbooks.Add "C:\midstate\item prices.xlsx" '<<<<<<<<<<<<< change WB path
Set wbItem = ActiveWorkbook

Set rTemp = wbItem.Worksheets("Sheet1").Range("C1")
Set rTemp = Range(rTemp, rTemp.End(xlDown))
vItems = Application.WorksheetFunction.Transpose(rTemp)
Set rTemp = wbItem.Worksheets("Sheet1").Range("E1")
Set rTemp = Range(rTemp, rTemp.End(xlDown))
vPrices = Application.WorksheetFunction.Transpose(rTemp)

wbItem.Close False



"Does anyone else have issues typing in the reply box in this forum. I think it is the auto save that keeps blocking keystroke? Can that be disabled?"

You have a line
Call ReplaceAllSheets(wsData.Range(A1”))

That seems like that would do what I want. It looks atthe rows I would want and then has the replace next to it. But I do not see anycode for replaceallsheets. I am trying to research and figure out on my own butit is taking me to much time and the boss has other things he wants me workingon. I am doing this more for myslef as a task I want to complete. But notlooking good yet?
I am still ned to macros. Have not had a lot of time tolearn what I need.

If all you want is the Find/Replace is a stand-alone macro, you can try this

It uses the worksheet 'data base' on Data for the Find+Replace pairs

Code:

---

Option Explicit
Sub Replaces()

    Dim wsData As Worksheet
    'make sure we're on the right sheet
    If ActiveSheet.Name = "Data" Then
        Call MsgBox("Can't do Replaces on the Data sheet. Pick another", vbCritical + vbOKOnly, "Replaces Macro")
        Exit Sub
    Else
        If MsgBox("Do you want to run the format macro on this sheet?", vbQuestion + vbYesNo, "Replaces Macro") = vbNo Then
            Exit Sub
        End If
    End If
   
    'setup and init
    Application.ScreenUpdating = False
    ActiveSheet.Name = "Input"
    Set wsData = Worksheets("Data")
    Call ReplaceAllSheets(wsData.Range("A1"))
    Call ReplaceAllSheets(wsData.Range("D1"))
    Call ReplaceAllSheets(wsData.Range("G1"))
    Application.ScreenUpdating = True
    Call MsgBox("Replaces macro completed", vbInformation + vbOKOnly, "Replaces Macro")

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.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



---

Thanks
I don’t think I am explaining good.
I am trying to create macro that will look at yourReplaces_1.xlsm file. Then if it finds anything that matches your column A itwill replace it with column B. Then if it finds anything that matches column Dit will replace it with column E and anything that matches column G it willreplace it with column H. Those are all found in the xlsm file you created.

So, when I run the macro from the file I want to convert “theworksheet will be named input in the file I am converting” it will referenceyour file to find and replace all of those items. I will keep your xlsm file in“C:\midstate”

So then anytime I need to add new stores I can just addthem to the replace_1.xlsm file rather than adding them to the find and replacemacro I am currently using. “It is a pain to add more to the when needed andwhen I leave it will be much easier for others to just add them to the xlsmfile rather than me teaching them how to add to the find and replace macro.Plus I am currently using 3 find and replace macros. One to replace items, oneto replace customer names and the other to replace common names.
I would prefer if it did not ask the person running themacro any questions, just does the task like me other one currently does.

Again, thanks for all the continued help you areproviding.

I am trying to manipulate this code

Dim wbItem As Workbook
Dim wsInput AsWorksheet
Dim rData AsRange, rData1 As Range, rLast As Range, rTemp As Range
Dim iRow AsLong, iItem As Long
Dim dDiscountAs Double
Dim vItems AsVariant, vPrices As Variant

Application.ScreenUpdating = False

'get normalprices
Workbooks.Add"C:\midstate\item prices.xlsx" ' <<<<<<<<<<<<< change WB path
Set wbItem =ActiveWorkbook

Set rTemp =wbItem.Worksheets("Sheet1").Range("C1")
Set rTemp =Range(rTemp, rTemp.End(xlDown))
vItems =Application.WorksheetFunction.Transpose(rTemp)
Set rTemp =wbItem.Worksheets("Sheet1").Range("E1")
Set rTemp =Range(rTemp, rTemp.End(xlDown))
vPrices =Application.WorksheetFunction.Transpose(rTemp)

wbItem.CloseFalse


'set data
Set wsInput =Worksheets("Sheet1") ' <<<<< Change WSname
Set rLast =wsInput.Cells(1, wsInput.Columns.Count).End(xlToLeft)
Set rData =Range(wsInput.Cells(1, 1), rLast).EntireColumn
Set rData =Intersect(rData, wsInput.Cells(1, 1).CurrentRegion.EntireRow)
Set rData1 =rData.Cells(2, 1).Resize(rData.Rows.Count - 1, rData.Columns.Count)


To do the same thing. To call the replace xlsm file to dothe find and replace. But I am not having luck. Keep getting errors and googlenot much help with the referencing another file.

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

Code:

---

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



---

I would prefer it to be in c:\midstate\replacedata.xlsx. so the user does not delete it by mistake. I tried what I have below but it run just does notmake any changes. The sheet I have all the data in is called input.

'open Replaces workbook and copy data sheet in
Workbooks.Open Filename:="c:\midstate\ReplaceData.xlsx" ' <<<<<<<<<<<<<<<<<
Set wbData = ActiveWorkbook
wbData.Worksheets("Data").Copy Before:=ThisWorkbook.Worksheets(1)
wbData.Close False

I also have a store that has the same name of anotherstore with in. That is why I had a macro called common store.
It is Budwey's-Market in The Square. Thereis also Market In The Square

So I had to add another findreplace to fix that “below” that would run after the first one. When I did get yours to run having it on desktopand both sheets within the one document it did that same as before. Made Budwey's-Marketin The Square into Budwey's-4Independent Stores:Market In The Square and itneeds to be 4Independent Stores:Budwey's-Market in The Square

I had this run ater the first one

Sub Replace_Budwey()
'PURPOSE: Find & Replace a list of text/values throughout entire workbook
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault

Dim sht As Worksheet
Dim fndList As Variant
Dim rplcList As Variant
Dim x As Long

fndList = Array("Budwey's-4Independent Stores:Market In The Square", "4Independent Stores:4Independent Stores:Niagara Produce Lockport")
rplcList = Array("4Independent Stores:Budwey's-Market in The Square", "4Independent Stores:Niagara Produce Lockport")
'Loop through each item in Array lists
For x = LBound(fndList) To UBound(fndList)
'Loop through each worksheet in ActiveWorkbook
For Each sht In ActiveWorkbook.Worksheets
sht.Cells.Replace What:=fndList(x), Replacement:=rplcList(x), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Next sht

Next x

End Sub





To run yours do I need to have any sheets within the workbook I want to convert. I only have the input sheet in the one io want to convert


Thanks

1. I'd change LookAt:=xlPart to LookAt:=xlWhole and then you don't need another macro

2. Worksheet "Input" should be in the workbook with the macro ('Replaces_1.xlsm' in my attachment)

3. "I only have the input sheet in the one I want to convert" -- then why are you looping through all worksheets??

4. "I would prefer it to be in c:\midstate\replacedata.xlsx." -- The 'database' ('ReplaceData.xlsx' in my attachments) can be anywhere that you have permissions. The Workbook.Open Filename:= … just has to match

Thanks for all the help. I think I am 100% complete and everything is working good. You have helped make things much better for once I leave.