PDA

View Full Version : [SOLVED] join models



joeny0706
02-18-2019, 01:15 PM
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

Paul_Hossler
02-18-2019, 02:11 PM
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




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

joeny0706
02-18-2019, 02:31 PM
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.

Paul_Hossler
02-18-2019, 03:21 PM
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



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

joeny0706
02-18-2019, 04:29 PM
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

joeny0706
02-19-2019, 06:57 AM
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?"

joeny0706
02-19-2019, 07:58 AM
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.

Paul_Hossler
02-19-2019, 08:01 AM
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




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

joeny0706
02-19-2019, 08:28 AM
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.

joeny0706
02-19-2019, 08:56 AM
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.

Paul_Hossler
02-19-2019, 10:16 AM
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

joeny0706
02-19-2019, 10:47 AM
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

joeny0706
02-19-2019, 10:53 AM
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 (http://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

Paul_Hossler
02-19-2019, 02:20 PM
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

joeny0706
02-20-2019, 08:57 AM
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.