Change text multiple WBs

[Jenawade]

We have to go through hundreds of workbooks to change one word. I'm hoping someone can help with this. The below is an example of the data. This information is not always in the same row and/or column. There will always be only one worksheet (each WB has a WS with a different name). If the number in G57 in this example (it will not always be in this exact cell, but nearby) starts with either 130620, 130618, 133362, 130604, then the word "BLUE" in cell G68 (may be in a different cell in other WBs) needs to be changed to "BLACK".

I'm hoping this is easy for someone and they can whip me up a macro that lets me pick a folder, then runs through looking for 130620, 130618, 133362, 130604 and when it finds that number, changes BLUE to BLACK.

Excel Workbook
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	P
49	*	*	*	*	*	*	*	*	*	*	*	*	*	*	*
50	UNIT LABEL REQUIREMENTS														*
51	1. *THE UNIT LABEL SHOULD HAVE CUSTOMER NUMBER:									05083789AA					*
52	2. *THE BARCODE SHOULD READ:					05083789AA									*
53	3. *THE CUSTOMER CODE IS:					55087AG									*
54	4. *THE COUNTRY OF ORIGIN SHOULD BE:							MEXICO							*
55	5. *THE QUANTITY SHOULD BE BEFORE THE CUSTOMER NUMBER.														*
56	6. *THE DATE MUST APPEAR ON THE LABEL.														*
57	7. *THE PART NUMBER OF THE LABEL IS:						130620 (L24)								*
58	8. THE MEASUREMENT IS:					2" X 4"									*
59	*	*	*	*	*	*	*	*	*	*	*	*	*	*	*
60	UNIT CARTON REQUIREMENTS														*
61	1. *THE UNIT CARTON IS:					130593									*
62	2. *(DESCRIPTION OF CARTON)						7X5X8.5 FOL								*
63	3. *(PLACEMENT OF LABEL.)					FLAP									*
64	4. *(CLOSURE PROCEDURE)					1/2" TAPE									*
65	5. *(POLYBAG)				N/A										*
66	*	*	*	*	*	*	*	*	*	*	*	*	*	*	*
67	MISC. INFORMATION														*
68	FINISHED KITS TO BE PLACED ON						BLUE			SKIDS		*	*	*	*
69	CORRUGATED SHIPPER NEEDED	*	*	*	*	*	*	*	*	*	*	*	*	*	*
70	OVERPACK LABELS NEEDED *4 X 6	*	*	*	*	*	*	*	*	*	*	*	*	*	*
71	*	*	*	*	*	*	*	*	*	*	*	*	*	*	*
143598

Thank you!

 

[Jenawade]

Well, this attempt doesn't work:

Sub UpdateLabels()

   FileNameXls = Application.GetOpenFilename(filefilter:="Excel Files, *.xl*", MultiSelect:=True)
            
   On Error Resume Next
   
   For FNum = LBound(FileNameXls) To UBound(FileNameXls)
           
   If Cells.find(What:="130620", after:=sh.Range("A30"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row _
   Then Cells.Replace What:="BLUE", Replacement:="BLACK", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
   
   If Cells.find(What:="130618", after:=sh.Range("A30"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row _
   Then Cells.Replace What:="BLUE", Replacement:="BLACK", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

   If Cells.find(What:="133362", after:=sh.Range("A30"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row _
   Then Cells.Replace What:="BLUE", Replacement:="BLACK", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

   If Cells.find(What:="130604", after:=sh.Range("A30"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row _
   Then Cells.Replace What:="BLUE", Replacement:="BLACK", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

   On Error GoTo 0

   Next FNum
        
        End If
End Sub

 

[Rick Rothstein]

If Cells.find(What:="130620",...[/code]

I might be afraid of this search mechanism... there is at least one other number on the worksheet of the same "size and shape" as 130620 (as well as the other numbers your code searches for) which might accidentally match the sought after number.

 

[Rick Rothstein]

This information is not always in the same row and/or column.

Is the text in Column A on the row the numbers you are looking for always "THE PART NUMBER OF THE LABEL IS"? I'm looking for something that is always on every label and always the same offset from the cells with the numbers you are searching for.

 

[Jenawade]

Is the text in Column A on the row the numbers you are looking for always "THE PART NUMBER OF THE LABEL IS"? I'm looking for something that is always on every label and always the same offset from the cells with the numbers you are searching for.

Yes it is :D

 

[Jenawade]

I don't understand. This 1st one errors out, telling me I have a next without a for, but there is a for. The 2nd one errors out, telling me I have a loop without a do, but there is do.

Sub UpdateLabels4()

Dim Match As Boolean

FileNameXls = Application.GetOpenFilename(filefilter:="Excel Files, *.xl*", MultiSelect:=True)

On Error Resume Next

For i = LBound(FileNameXls) To UBound(FileNameXls)

        Match = ActiveWorkbook.ActiveSheet.Cells.find(What:=130620, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate

        If Match Then
        Cells.Replace What:="BLUE", Replacement:="BLACK", LookAt:=xlPart
        Cells.Replace What:="ORANGE", Replacement:="BLACK", LookAt:=xlPart

        Match = ActiveWorkbook.ActiveSheet.Cells.find(What:=130618, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate

        If Match Then
        Cells.Replace What:="BLUE", Replacement:="BLACK", LookAt:=xlPart
        Cells.Replace What:="ORANGE", Replacement:="BLACK", LookAt:=xlPart
  
        Match = ActiveWorkbook.ActiveSheet.Cells.find(What:=133362, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate

        If Match Then
        Cells.Replace What:="BLUE", Replacement:="BLACK", LookAt:=xlPart
        Cells.Replace What:="ORANGE", Replacement:="BLACK", LookAt:=xlPart

        Match = ActiveWorkbook.ActiveSheet.Cells.find(What:=130604, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate

        If Match Then
        Cells.Replace What:="BLUE", Replacement:="BLACK", LookAt:=xlPart
        Cells.Replace What:="ORANGE", Replacement:="BLACK", LookAt:=xlPart

  Next i

End Sub

Sub UpdateLabels5()

Dim oWbk As Workbook
Dim sFil As String
Dim sPath As String

sPath = Application.GetOpenFilename(filefilter:="Excel Files, *.xl*", MultiSelect:=True)
ChDir sPath
sFil = Dir("*.xls")
Do While sFil <> ""

        Match = ActiveWorkbook.ActiveSheet.Cells.find(What:=130620, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate

        If Match Then
        Cells.Replace What:="BLUE", Replacement:="BLACK", LookAt:=xlPart
        Cells.Replace What:="ORANGE", Replacement:="BLACK", LookAt:=xlPart

        Match = ActiveWorkbook.ActiveSheet.Cells.find(What:=130618, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate

        If Match Then
        Cells.Replace What:="BLUE", Replacement:="BLACK", LookAt:=xlPart
        Cells.Replace What:="ORANGE", Replacement:="BLACK", LookAt:=xlPart
  
        Match = ActiveWorkbook.ActiveSheet.Cells.find(What:=133362, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate

        If Match Then
        Cells.Replace What:="BLUE", Replacement:="BLACK", LookAt:=xlPart
        Cells.Replace What:="ORANGE", Replacement:="BLACK", LookAt:=xlPart

        Match = ActiveWorkbook.ActiveSheet.Cells.find(What:=130604, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate

        If Match Then
        Cells.Replace What:="BLUE", Replacement:="BLACK", LookAt:=xlPart
        Cells.Replace What:="ORANGE", Replacement:="BLACK", LookAt:=xlPart

oWbk.Close True
sFil = Dir
Loop
End Sub

 

[Rick Rothstein]

I don't understand. This 1st one errors out, telling me I have a next without a for, but there is a for. The 2nd one errors out, telling me I have a loop without a do, but there is do.

Sorry I haven't had time to get back to your question yet (probably this afternoon sometime), but a quick look at your code shows you are missing several "End If" statements... these are needed to close off the If..Then blocks of code you started (just putting a blank space under the code block is not enough to close the If..Then block... you must use "End If" to do that. As for the particularly unhelpful message you are getting... VB treats all block closing statements the same when it counts them up to see if they match the number of block opening statements (If, For, Do, etc.)... the first unclosed block it comes to (the For or Do ones in your case) is what it reports in the error message... its a false indicator in this case.

 

[Jenawade]

Thanks. I had them in an earlier version and an error popped up and highlighted the first End If when I clicked debug, so I took them out. LOL