Changing two cells in multiple files

[jhightowerisc]

Hello everyone

I want to be able to change two cells in hundreds of files.

One cell is M2 and is currently a dropdown box i want to replace with the NPI

The other cell is little different

C1 current has a part number that is in this format 100xxxx i want to be able to make that 1000xxxx without changing the last four digits.


Thanks for listening

 

[jhightowerisc]

Hello dear thank you for providing the feedback, I am also a learner, I checked with input you gave, that was an error, so I changed my code and and providing you with the new one , I hope it works for you, please check and provide the feedback

Sub mycode()

Dim ws As Worksheet
Dim i As Integer
Dim search_x() As String

Dim cvalue As String
Dim firstpart As String
Dim lastpart As String
On Error GoTo leave

For Each ws In ActiveWorkbook.Worksheets
    ws.Range("M2").Value = "npi"
    ReDim search_x(1 To Len(ws.Range("c1").Value) - 1)
    For i = 1 To Len(ws.Range("c1").Value) - 1
     search_x(i) = Mid(ws.Range("c1").Value, i + 1, 1)
     Next i
     For i = 1 To Len(ws.Range("c1").Value) - 1
        If search_x(i) <> "0" Then
            cvalue = ws.Range("c1").Value
            firstpart = Mid(cvalue, 1, i)
            lastpart = Mid(cvalue, i + 1, Len(cvalue) - i)
        ws.Range("c1").Value = firstpart & "0" & lastpart
        Exit Sub
        End If
    Next i
Next
leave:
End Sub

Perfect. Just need to be able to do that to 200 more files in a folder.

 

[ER_Neha]

Perfect. Just need to be able to do that to 200 more files in a folder.

Hello glad to see it worked for you. okay to be specific this code will work only when the numbers in c1 cell has the value of type 10xxx, 100xxxx and similar, but wont work well if your value is like 525005 or similar. because as the criteria mentioned by you in the query i wrote accordingly, below is the code for multiple files. a pop up to select a folder will appear where you have all you 200 files stored. and the actions will happen behind the screen in background.

Do provide a feedback if it works for you

Sub mycode()

Dim filedir As String
Dim filetolist As String
Dim openbook As Workbook

Application.ScreenUpdating = False

With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Please select the folder"
    .ButtonName = "Pick Folder"
    If .Show = 0 Then
        MsgBox "Nothing was selected"
        Exit Sub
    Else
        filedir = .SelectedItems(1) & "\"
    End If
End With

filetolist = Dir(filedir & "*.xlsx")

Do Until filetolist = ""
DoEvents
    
    Set openbook = Workbooks.Open(filedir & filetolist)

Dim ws As Worksheet
Dim i As Integer
Dim search_x() As String

Dim cvalue As String
Dim firstpart As String
Dim lastpart As String
On Error GoTo leave

For Each ws In openbook.Worksheets
    ws.Range("M2").Value = "npi"
    If Not IsEmpty(ws.Range("c1").Value) Then
        ReDim search_x(1 To Len(ws.Range("c1").Value) - 1)
        For i = 1 To Len(ws.Range("c1").Value) - 1
         search_x(i) = Mid(ws.Range("c1").Value, i + 1, 1)
         Next i
         For i = 1 To Len(ws.Range("c1").Value) - 1
            If search_x(i) <> "0" Then
                cvalue = ws.Range("c1").Value
                firstpart = Mid(cvalue, 1, i)
                lastpart = Mid(cvalue, i + 1, Len(cvalue) - i)
            ws.Range("c1").Value = firstpart & "0" & lastpart
            GoTo solution
            End If
        Next i
    End If
solution:
Next
    openbook.Save
    openbook.Close
    filetolist = Dir
Loop

Application.ScreenUpdating = True

leave:
End Sub

 

[jhightowerisc]

Hello glad to see it worked for you. okay to be specific this code will work only when the numbers in c1 cell has the value of type 10xxx, 100xxxx and similar, but wont work well if your value is like 525005 or similar. because as the criteria mentioned by you in the query i wrote accordingly, below is the code for multiple files. a pop up to select a folder will appear where you have all you 200 files stored. and the actions will happen behind the screen in background.

Do provide a feedback if it works for you

Sub mycode()

Dim filedir As String
Dim filetolist As String
Dim openbook As Workbook

Application.ScreenUpdating = False

With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Please select the folder"
    .ButtonName = "Pick Folder"
    If .Show = 0 Then
        MsgBox "Nothing was selected"
        Exit Sub
    Else
        filedir = .SelectedItems(1) & "\"
    End If
End With

filetolist = Dir(filedir & "*.xlsx")

Do Until filetolist = ""
DoEvents
    
    Set openbook = Workbooks.Open(filedir & filetolist)

Dim ws As Worksheet
Dim i As Integer
Dim search_x() As String

Dim cvalue As String
Dim firstpart As String
Dim lastpart As String
On Error GoTo leave

For Each ws In openbook.Worksheets
    ws.Range("M2").Value = "npi"
    If Not IsEmpty(ws.Range("c1").Value) Then
        ReDim search_x(1 To Len(ws.Range("c1").Value) - 1)
        For i = 1 To Len(ws.Range("c1").Value) - 1
         search_x(i) = Mid(ws.Range("c1").Value, i + 1, 1)
         Next i
         For i = 1 To Len(ws.Range("c1").Value) - 1
            If search_x(i) <> "0" Then
                cvalue = ws.Range("c1").Value
                firstpart = Mid(cvalue, 1, i)
                lastpart = Mid(cvalue, i + 1, Len(cvalue) - i)
            ws.Range("c1").Value = firstpart & "0" & lastpart
            GoTo solution
            End If
        Next i
    End If
solution:
Next
    openbook.Save
    openbook.Close
    filetolist = Dir
Loop

Application.ScreenUpdating = True

leave:
End Sub

It works and it's just what i needed. thank you

 

[ER_Neha]

It works and it's just what i needed. thank you

thank you i learnt a lot. glad i could help. please mark it as a answer , it justify your query for making it useful for others. thank you