Vba - Change a cell value in all worksheets in every workbook in a folder

Cuzzaa

Board Regular
Joined
Apr 30, 2019
Messages
86
Hi everyone!

I am using the code below to change a cell value in all worksheets in every workbook in a folder, but I was hoping someone would be able to kindly help amend my code so that instead of having to predetermine the static cell value in the vba to change in all of the workbooks, I would like the cell value of cell F14 in the active workbook to be added to the existing cell value in F2 in each of the .csv workbooks in the folder instead.

VBA Code:
Sub ApplyOffets()


    Dim MyPath As String, FilesInPath As String
    Dim MyFiles() As String, Fnum As Long
    Dim mybook As Workbook
    Dim CalcMode As Long
    Dim sh As Worksheet
    Dim ErrorYes As Boolean

    'Fill in the path\folder where the files are
    MyPath = "C:\Users\joe.blogs\Test Folder\"

    'Add a slash at the end if the user forget it
    If Right(MyPath, 1) <> "\" Then
        MyPath = MyPath & "\"
    End If

    'If there are no Excel files in the folder exit the sub
    FilesInPath = Dir(MyPath & "*.csv*")
    If FilesInPath = "" Then
        MsgBox "No files found"
        Exit Sub
    End If

    'Fill the array(myFiles)with the list of Excel files in the folder
    Fnum = 0
    Do While FilesInPath <> ""
        Fnum = Fnum + 1
        ReDim Preserve MyFiles(1 To Fnum)
        MyFiles(Fnum) = FilesInPath
        FilesInPath = Dir()
    Loop

    'Change ScreenUpdating, Calculation and EnableEvents
    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Loop through all files in the array(myFiles)
    If Fnum > 0 Then
        For Fnum = LBound(MyFiles) To UBound(MyFiles)
            Set mybook = Nothing
            On Error Resume Next
            Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
            On Error GoTo 0

            If Not mybook Is Nothing Then


                'Change cell value(s) in one worksheet in mybook
                On Error Resume Next
                With mybook.Worksheets(1)
                    If .ProtectContents = False Then
                        .Range("F2").Value = "Test Successful!"
                    Else
                        ErrorYes = True
                    End If
                End With


                If Err.Number > 0 Then
                    ErrorYes = True
                    Err.Clear
                    'Close mybook without saving
                    mybook.Close savechanges:=False
                Else
                    'Save and close mybook
                    mybook.Close savechanges:=True
                End If
                On Error GoTo 0
            Else
                'Not possible to open the workbook
                ErrorYes = True
            End If

        Next Fnum
    End If

    If ErrorYes = True Then
        MsgBox "There are problems in one or more files, possible problem:" _
             & vbNewLine & "protected workbook/sheet or a sheet/range that not exist"
    End If

    'Restore ScreenUpdating, Calculation and EnableEvents
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = CalcMode
    End With
End Sub

Does anyone know if there is a simple way to achieve this please?

Thanks so much!
 

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.
Just capture the value at the very beginning of your code while you have the workbook active like this:
VBA Code:
MyVal = ActiveWorkbook.Range("F14")
and then you can reference/use MyVal whenever you want later in your code.
 
Upvote 0
Just capture the value at the very beginning of your code while you have the workbook active like this:
VBA Code:
MyVal = ActiveWorkbook.Range("F14")
and then you can reference/use MyVal whenever you want later in your code.

Hi,

Thanks very much for offering to help, I've tried the above but I'm afraid I don't quite understand (I'm a bit of a beginner) I've tried following your suggestion but I just receive an error so I must be applying the changes into my code incorrectly!

Would you be so kind to help edit my code for me so that I understand?
 
Upvote 0
I am assuming then that the code that you are using you did not write yourself.

Since you are a beginner, this is a good learning experience. Please post your code, what you attempted (showing the changes your tried), and we can help you fix it up.
 
Upvote 0
I am assuming then that the code that you are using you did not write yourself.

Since you are a beginner, this is a good learning experience. Please post your code, what you attempted (showing the changes your tried), and we can help you fix it up.

Yep that's right, although I have made some subtle changes to it.

This is what I've tried (sorry I know I'm a bit dim...) and I'm doing it very wrong (but trying to learn).

VBA Code:
Sub ApplyOffets()

    Dim MyPath As String, FilesInPath As String
    Dim MyFiles() As String, Fnum As Long
    Dim mybook As Workbook
    Dim CalcMode As Long
    Dim sh As Worksheet
    Dim ErrorYes As Boolean
   
    MyVal = ActiveWorkbook.Range("F14")

    'Fill in the path\folder where the files are
    MyPath = ThisWorkbook.Sheets("Sheet1").Range("D1").Text

    'Add a slash at the end if the user forget it
    If Right(MyPath, 1) <> "\" Then
        MyPath = MyPath & "\"
    End If

    'If there are no Excel files in the folder exit the sub
    FilesInPath = Dir(MyPath & "*.csv*")
    If FilesInPath = "" Then
        MsgBox "You must import a folder first!", vbCritical
        Exit Sub
    End If

    'Fill the array(myFiles)with the list of Excel files in the folder
    Fnum = 0
    Do While FilesInPath <> ""
        Fnum = Fnum + 1
        ReDim Preserve MyFiles(1 To Fnum)
        MyFiles(Fnum) = FilesInPath
        FilesInPath = Dir()
    Loop

    'Change ScreenUpdating, Calculation and EnableEvents
    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Loop through all files in the array(myFiles)
    If Fnum > 0 Then
        For Fnum = LBound(MyFiles) To UBound(MyFiles)
            Set mybook = Nothing
            On Error Resume Next
            Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
            On Error GoTo 0

            If Not mybook Is Nothing Then


                'Change cell value(s) in one worksheet in mybook
                On Error Resume Next
                With mybook.Worksheets(1)
                    If .ProtectContents = False Then
                        .Range("F2").Value = MyVal
                    Else
                        ErrorYes = True
                    End If
                End With


                If Err.Number > 0 Then
                    ErrorYes = True
                    Err.Clear
                    'Close mybook without saving
                    mybook.Close savechanges:=False
                Else
                    'Save and close mybook
                    mybook.Close savechanges:=True
                End If
                On Error GoTo 0
            Else
                'Not possible to open the workbook
                ErrorYes = True
            End If

        Next Fnum
    End If

    If ErrorYes = True Then
        MsgBox "There are problems in one or more files, possible problem:" _
             & vbNewLine & "protected workbook/sheet or a sheet/range that not exist"
    End If

    'Restore ScreenUpdating, Calculation and EnableEvents
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = CalcMode
    End With
End Sub

What I'm trying to achieve is to update the cell values in column F (but ignoring F1 and blanks) in the first .csv file that is being imported (from the directory path set in cell D1) to the result of the existing values in column F with the value typed into the active sheet in cell F14.

I.e. if the cell value in cell F2 in the .csv file being imported = 14, and the number typed into cell F14 in the active workbook = 20 then I would like cell F2 in the .csv file to be updated to the sum of both, i.e. 34. And then so on for column F in the .csv file but ignoring blanks.

Ultimately, I also need to make sure that the existing .csv is saved but not overwritten, instead to create a new copy in the same folder with the same filename but with the word 'Edited' at the end.

Would you be able to offer any support please?

Thanks so much!
 
Upvote 0
I've also found the below code which apparently can be used for saving a file once a change has been made but creating a new copy and splitting the filename so it's saved as a new file with the same filename but adding 'Edited' on the end, but I'm struggling to work out how to implement this logic into my code above :(

VBA Code:
   newpath = oneup(ws.Range("D1").Value) & "\" & Split(ws.Range("D1").Value, "\")(UBound(Split(ws.Range("D1").Value, "\"))) & " Edited"
 
Upvote 0
I am a very visual person, and am having a very hard time visualizing this without seeing sample files (i.e. what the original files look like, and what you want your expected results to look like).

Any chance you can post either images of those (using this tool here: XL2BB - Excel Range to BBCode) or upload sample files to a share site (and post the links here)?
 
Upvote 0
I am a very visual person, and am having a very hard time visualizing this without seeing sample files (i.e. what the original files look like, and what you want your expected results to look like).

Any chance you can post either images of those (using this tool here: XL2BB - Excel Range to BBCode) or upload sample files to a share site (and post the links here)?

Thanks Joe.

Please see below (you can't see my buttons at the top but they're there!) the results below are the imported data using my first button which I am using to select a folder which then imports all .csv files located in the folder, in this case there are 5 files. The names of these files are then stored below. It also imports the cell value of F1 into the below under the 'Channel' heading. I have got this macro running fine now and does exactly what I need.

The 2nd button is the one I am trying to get working. What I am trying to achieve is that when run, it then re-opens all of the .csv files imported and instead adds the specific 'custom offset value' I have typed in against each row below into cell range F2 in the second screenshot below and all subsequent rows that are not blank of the .csv files imported.

The macro should loop through and apply the specific custom offset value to column F (ignorning F1 as it's the heading) to each of the specific .csv files while creating a new copy of each of the files in the same file as to avoid overwriting the original data.

I hope that makes sense?

This is my current code below I have got set up for my 2nd macro but at the moment but as you will see it doesn't quite do what I need it to yet but I am trying to slowly work out how to amend it so that I achieve the above :)

VBA Code:
Sub Offsets()


    Dim MyPath As String, FilesInPath As String
    Dim MyFiles() As String, Fnum As Long
    Dim mybook As Workbook
    Dim CalcMode As Long
    Dim sh As Worksheet
    Dim ErrorYes As Boolean

    'Fill in the path\folder where the files are
    MyPath = ThisWorkbook.Sheets("Sheet1").Range("D1").Text

    'Add a slash at the end if the user forget it
    If Right(MyPath, 1) <> "\" Then
        MyPath = MyPath & "\"
    End If

    'If there are no Excel files in the folder exit the sub
    FilesInPath = Dir(MyPath & "*.csv*")
    If FilesInPath = "" Then
        MsgBox "No files found"
        Exit Sub
    End If

    'Fill the array(myFiles)with the list of Excel files in the folder
    Fnum = 0
    Do While FilesInPath <> ""
        Fnum = Fnum + 1
        ReDim Preserve MyFiles(1 To Fnum)
        MyFiles(Fnum) = FilesInPath
        FilesInPath = Dir()
    Loop

    'Change ScreenUpdating, Calculation and EnableEvents
    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Loop through all files in the array(myFiles)
    If Fnum > 0 Then
        For Fnum = LBound(MyFiles) To UBound(MyFiles)
            Set mybook = Nothing
            On Error Resume Next
            Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
            On Error GoTo 0

            If Not mybook Is Nothing Then



                'Change cell value(s) in one worksheet in mybook
                On Error Resume Next
                With mybook.Worksheets(1)
                    If .ProtectContents = False Then
                    
                        .Range("F2").Value = "Test"
                        
                        
                       
                        
                        
                    Else
                        ErrorYes = True
                    End If
                End With


                If Err.Number > 0 Then
                    ErrorYes = True
                    Err.Clear
                    'Close mybook without saving
                    mybook.Close savechanges:=False
                Else
                    'Save and close mybook
                    mybook.Close savechanges:=True
                End If
                On Error GoTo 0
            Else
                'Not possible to open the workbook
                ErrorYes = True
            End If

        Next Fnum
    End If

    If ErrorYes = True Then
        MsgBox "There are problems in one or more files, possible problem:" _
             & vbNewLine & "protected workbook/sheet or a sheet/range that not exist"
    End If

    'Restore ScreenUpdating, Calculation and EnableEvents
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = CalcMode
    End With
End Sub

Visual of my activebook:

Book1
ABCDEFGH
1C:\Users\joe.blog\Desktop\Test Folder
2Tom's CW Normaliser Calculator - Beta
3
4*To begin, click on Import Folder to import each of the channels from all .csv files contained within the folder.*Change the values below and click Edit Channel Offsets to apply the custom offsets to each channel imported.
5
6
7
8
9
10Import complete!*Enter custom offset values below.
11
12#FilenameChannelFrequencyCustom Offset Values
13
141IBflex Device 081611021_LTE_EB 01 2100 (IMT-2000) DL_RSSI 100 KHz (CW).csv150L2100 PATH A24
152
162IBflex Device 081611021_LTE_EB 03 1800 (DCS) DL_RSSI 100 KHz (CW).csv1201L1800 PATH A-10
174
183IBflex Device 081611021_LTE_EB 07 2600 (IMT Extension) DL_RSSI 100 KHz (CW).csv2750L2600 PATH A4
19
204IBflex Device 081611021_TD-LTE_EB 40 TDD 2.4 GHz_RSSI 100 KHz (CW).csv39150L2300 PATH A8
21
225IBflex Device 081611021_UMTS WCDMA_UB I 2100 (IMT-2000) DL_RSSI 200 KHz (CW).csv10625L2100 PATH A35
23
2460
25
2670
27
2880
29
3090
31
32100
33
34
35
Sheet1
Cell Formulas
RangeFormula
E14, E32, E30, E28, E26, E24, E22, E20, E18, E16E14=IFERROR(VLOOKUP($D14,Sheet2!$A$1:$B$48,2,FALSE),0)


Visual below of one of the example .csv files I am importing, and then the 2nd macro needs to update all of the data in column F with the existing values + the custom offset value manually set in the above:

Book1
ABCDEFGHIJ
1DateTimeLatitudeLongitudeChannelRSSINormalisedAdjusted ValueAntenna GainCable Loss
21/23/202002:13:44:67640.00021482-79.9990933239150-54.46-86.45-55.6500
31/23/202002:13:44:69940.00021501-79.9990933239150-53.94-84.74-53.9400
41/23/202002:13:44:72540.0002152-79.9990933139150-54.58-85.38-54.5800
51/23/202002:13:44:75540.00021538-79.999093339150-54.8-85.6-54.800
61/23/202002:13:44:78640.00021557-79.9990932939150-54.66-85.46-54.6600
71/23/202002:13:44:80740.00021576-79.9990932839150-55.05-85.85-55.0500
81/23/202002:13:44:83640.00021595-79.9990932739150-54.19-84.99-54.1900
91/23/202002:13:44:86140.00021613-79.9990932639150-53.41-84.21-53.4100
101/23/202002:13:44:92640.00021632-79.9990932639150-54-84.8-5400
111/23/202002:13:44:93640.00021651-79.9990932539150-54.64-85.44-54.6400
121/23/202002:13:44:94440.00021669-79.9990932439150-53.35-84.15-53.3500
131/23/202002:13:44:96840.00021688-79.9990932339150-53.26-84.06-53.2600
IBflex Device 081611021_TD-LTE_


Hope this helps explain things a bit clearer. I am truly grateful for any help you can give me.

Thank you
 
Upvote 0
The 2nd button is the one I am trying to get working. What I am trying to achieve is that when run, it then re-opens all of the .csv files imported and instead adds the specific 'custom offset value' I have typed in against each row below into cell range F2 in the second screenshot below and all subsequent rows that are not blank of the .csv files imported.

The macro should loop through and apply the specific custom offset value to column F (ignorning F1 as it's the heading) to each of the specific .csv files while creating a new copy of each of the files in the same file as to avoid overwriting the original data.

I hope that makes sense?
I am afraid, that unfortunately, it does not (at least not to me). What I thought was just a simple straightforward question I see now is part of a much bigger. complex problem. You seem to have a lot going on, and I am not understanding how it all ties together, at least not from the descriptions presented here.. Who helped you come up with the code initially?

Typically, with problems like this, I find the most success happens when you can work hand-in-hand with a single consultant, where they have access to all of your files, and you can go through things together, step-by-step, and line-by-line, and they work on with you the whole way through, front start to end. To have different people work on various pieces of it along the way can be a bit challenging, unless you can really articulate exactly what needs to happen in precise descriptions.
 
Upvote 0
Hi Joe

No problem at all. Thanks for offering to try and help anyway, I’m very appreciate for your time. I was trying to cut the process down into smaller stages but I guess like you said it probably only over-complicates things.

Please feel free to close this thread.

Thanks again
 
Upvote 0

Forum statistics

Threads
1,213,550
Messages
6,114,265
Members
448,558
Latest member
aivin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top