The following code works:
Dim shts As Sheets
Set shts = Sheets(Array("Sheet1", "Sheet2"))
What I would like to do is add sheets that may be created in the future to the shts collection. The way I thought this would be accomplished involves using a loop where the sheet names are joined in a large string, making sure to obey the same formatting as in the example above. This is my non-working code:
Dim shts As Sheets
Dim wks() As Worksheet
Dim str As String
ReDim wks(0 To Sheets.Count)
Set wks(0) = Sheets(1)
str = wks(0).Name & """"
For i = 1 To UBound(wks)
Set wks(i) = Sheets(i)
str = str & ", """ & wks(i).Name & ""
Next i
Set shtsToProtect = Sheets(Array(str)) ' ERROR
[Run-time error '9': Subscript out of range]
I've tried several variants of the string argument, still no luck.
You can collect the subset sheets name into a string separated by given delimiter and then use Split() function to get an array out of it
Sub Test()
With ThisWorkbook
Dim shSubSetNames As String
Dim sh As Worksheet
For Each sh In .Worksheets
If sh.Name Like "Sheet*" Then ' change criteria as per your needs
shSubSetNames = shSubSetNames & sh.Name & "|"
End If
Next
If shSubSetNames <> vbNullString Then
shSubSetNames = Left$(shSubSetNames, Len(shSubSetNames) - 1)
Dim subSetShts As Sheets
Set shts = Sheets(Split(shSubSetNames, "|"))
shts.Select
End If
End With
End Sub
This is a solution to directly get to your goal, based on the code you wrote so far. You probably need to realize that having an array of worksheet names is not the same as only a string of names separated by commas. The latter is still just a string, not an array.
Sub Foo()
Dim i As Long
Dim shts() As String
ReDim shts(1 To ThisWorkbook.Worksheets.Count)
For i = 1 To ThisWorkbook.Worksheets.Count
shts(i) = ThisWorkbook.Worksheets(i).Name
Next i
Worksheets(shts).Select
End Sub
But as noted in the comments, there is something much simpler you can do:
Sub Bar()
ActiveWorkbook.Worksheets.Select
End Sub
So I've got this Excel workbook that has some macro's. Users are presented with a button to either create a worksheet with the current date as name, or enter a date manually and that worksheet will be created.
Now the issue: The worksheet has two sheet ('Initial' and 'Version') that must be first and last. However, all worksheets created in between should be sorted on date everytime a new sheet is created. And I mean sorted on date, the sheets are 'DD-MM-YY' so e.g. I could have names like '1-11-21', '2-11-21', '11-11-21' and '21-11-21' in the same workbook and it should be sorted ascending.
Any suggestions? A normal sort just messes things up I found (1-11-21 and 11-11-21, followed by '2-11-21' and '21-11-21'....
Thanks,
Jasper
Sorting sheets of a workbook is rather easy, there a numerous examples out there, looking more or less like this:
Sub SortSheets(Optional wb As Workbook = Nothing)
If wb Is Nothing Then Set wb = ActiveWorkbook ' (or maybe ThisWorkbook)
Application.ScreenUpdating = False
Dim i As Long, j As Long
For i = 1 To wb.Worksheets.Count - 1
For j = i + 1 To wb.Worksheets.Count
' ==> The following line needs to be replaced!
If wb.Worksheets(j).Name < wb.Worksheets(i).Name Then
wb.Worksheets(j).Move before:=wb.Worksheets(i)
End If
Next j
Next i
' Application.ScreenUpdating = True
End Sub
The only logic you need to change now is the If-statement. Instead of comparing the names of the sheets, you need to find a custom logic that compares the names of the two sheets.
Your logic is basically: If the name is Initial, sort it to the top, if it is Version, sort it to the end and for all the others, sort them by the date the name is representing.
I created a small function that calculates a number from the name. The Initial sheets gets 0, the Version gets a arbitrary high number, a worksheet with a date in the name gets the date value (a date is basically a double value in VBA) by converting the name into the date. If the name cannot be converted to a date, the value will be so that the sheet will be sorted to the end (but before the version sheet).
Function getSortNumber(ws As Worksheet) As Double
Const MaxNumber = 100000
If ws.Name = "Initial" Then
' Sort Initial to the beginning
getSortNumber = 0
ElseIf ws.Name = "Version" Then
' Sort Version to the end
getSortNumber = MaxNumber + ws.Parent.Sheets.Count
Else
' Create real date fom name
Dim d As Date, tokens() As String
tokens = Split(ws.Name, "-")
On Error Resume Next
d = DateSerial(Val(tokens(2)), Val(tokens(1)), Val(tokens(0)))
On Error GoTo 0
If d = 0 Then
' Failed to convert to date, sort to end
getSortNumber = MaxNumber + ws.Index
Else
' Sort according to the date value
getSortNumber = CDbl(d)
End If
End If
End Function
You can adapt the function easily if your needs changed (eg date format, or you can have extra text with the date, or you want to sort the version sheet to the beginning, or you have additional sheets with different names...). The sort function itself will not change at all, only the comparison logic.
Now all you have to do is change the line in the sort routine:
If wb.Worksheets(j).Name < wb.Worksheets(i).Name Then
to
If getSortNumber(wb.Worksheets(j)) < getSortNumber(wb.Worksheets(i)) Then
The general approach of converting the sheet names (that, hopefully, look like dates) to actual date serial numbers, and sorting those has been answered. But there is a a bit more to it than other answers show.
If your sheet names are user entered, you should handle a bit of variability
No need to reinvent Date Conversion, use whats already in Excel/VBA. But you need to define what year a 2 digit number represents, specifically which century it's in.
Note: How DateSerial interprets 2 digit dates is a bit complex. Refer to the docs for details
Decide what you want to do with sheets whose names cannot be converted to valid dates. Options include
Clean them up. eg
remove excess white space
allow for suffixes (times?)
alternate delimiters
other date forms (eg 1 Oct 2020)
etc
Aborting
Delete them
Move them to a defined location
Move them to another workbook
Prompt user for a new valid name
Generate a new valid name in the code
etc
Once the date serial numbers are created, you sort that data. Many options exist
Use the Dynamic Array function SORT, if you have it
If you don't, there are many Array Sort algorithms and implementations available for VBA
Examples 1 2
Use a data structure that supports Sorting. Example System.Collections.ArrayList 1
Dump the data onto a sheet and use Excel Sort
Once you have the sorted data, move the sheets into place. Note: another answer provide a nested For loop. This executes in order n^2 (n = number of sheets) May not matter for a smallish number of sheets, but will get much slower as the number of sheets increases. But it's easily avoided, see the code below.
Suggested methodoligy, including comments on what to change to suit your needs. Run this after the user has inserted a new sheet.
Sub SortSheets()
Dim ws As Worksheet
Dim wb As Workbook
Dim idx As Long
Dim SheetNames As Variant
Set wb = ThisWorkbook ' or specify the book you want
' Validate book contents
On Error Resume Next
Set ws = wb.Worksheets("Initial")
On Error GoTo 0
If ws Is Nothing Then
' Initial Doesn't exist. What now?
Exit Sub
End If
If ws.Index <> 1 Then
' Move it to first
ws.Move Before:=wb.Worksheets(1)
End If
On Error Resume Next
Set ws = wb.Worksheets("Version")
On Error GoTo 0
If ws Is Nothing Then
' Version Doesn't exist. What now?
Exit Sub
End If
If ws.Index <> wb.Worksheets.Count Then
' Move it to last
ws.Move After:=wb.Worksheets(wb.Worksheets.Count)
End If
' For each sheet between first and last,
' Convert Name to a dateSerial
' Handle any invalidly named sheets
ReDim SheetNames(2 To wb.Worksheets.Count - 1, 1 To 2)
For idx = 2 To wb.Worksheets.Count - 1
Set ws = wb.Worksheets(idx)
On Error Resume Next
' convert sheet name to date
SheetNames(idx, 1) = getDate(ws.Name)
On Error GoTo 0
If IsEmpty(SheetNames(idx, 1)) Then
' Invalid Sheet Name format. What Now?
' eg move it to the end (before Version)
SheetNames(idx, 1) = 3000000
' change to handle as you require, eg Delete it, Prompt user for a new name, etc
End If
SheetNames(idx, 2) = ws.Name
Next
' Sort on date using Dynamic Array Function SORT
SheetNames = Application.Sort(SheetNames)
' If SORT is not available, there are many Array Sort algorithms and implementations available
' Move sheets into position
' SheetNames is a 2D array of the DateSerial numbers and actual sheet names, sorted in the order we want them in the book
' Loop through the array lowest to highest,
' Get a reference to the sheet by name
' Move it to its required position (if it's not already there)
For idx = 1 To UBound(SheetNames, 1)
Set ws = wb.Worksheets(SheetNames(idx, 2))
If ws.Index <> idx + 1 Then
ws.Move After:=wb.Worksheets(idx)
End If
Next
End Sub
Function getDate(DateStr As String, Optional Delim As String = "-") As Long
' Cleanup sheet name
' Add or remove cleaning to suit your needs
' reduce multiple space sequences to single spaces
DateStr = Application.WorksheetFunction.Trim(DateStr)
' remove spaces aroung delimiter
DateStr = Replace$(DateStr, " " & Delim, Delim) '
DateStr = Replace$(DateStr, Delim & " ", Delim)
' replace any remaining spaces with delimiter (needed to make Val() work as desired)
DateStr = Replace$(DateStr, " ", Delim)
' Create real date from name
Dim d As Long, Segments() As String
Segments = Split(DateStr, Delim)
If UBound(Segments) < 2 Then
' not enough segments
d = 0
ElseIf UBound(Segments) > 2 Then
' too many segments. What Now?
' do nothing if it's acceptable to ignore anything after the date
Else
' Segment(0) is first part, assumed to be Day
' Segment(1) is second part, assumed to be Month
' Segment(2) is third part, assumed to be Year
' assume 2 digit dates are 2000's. Change to suit your needs
' Note: relying on DateSerial to convert 2 digit dates may give unexpected results
' as what you get depends on Excel version and local settings
If Len(Segments(2)) <= 2 Then Segments(2) = "20" & Format$(Segments(2), "00")
On Error Resume Next
d = CLng(DateSerial(CInt(Val(Segments(2))), CInt(Segments(1)), CInt(Segments(0))))
On Error GoTo 0
End If
If d = 0 Then
' Could not convert to date. Let calling routine decide what to do now
Err.Raise 1, "getDate", "Invalid Date string"
Else
' return date value
getDate = d
End If
End Function
Insert Date Worksheet
Note the following in two-digit year notation:
01/01/30 ... 01/01/1930
12/31/99 ... 12/31/1999
01/01/00 ... 01/01/2000
12/31/29 ... 12/31/2029
Some complications are present due to:
Sub Test1()
Debug.Print DateSerial(111, 22, 33) ' Result '11/02/112'
Debug.Print DateSerial(21, 2, 30) ' Result ' 03/02/2021
End Sub
The following will not sort any previously added worksheets. It will just insert the new worksheet in the right spot i.e. before the first worksheet with a greater date than the date supplied, or before the last worksheet (if no greater date).
Option Explicit
Sub InsertDateWorksheet()
' Needs 'RefWorksheet', 'InputDateText', 'GetTwoDigitYearDate' and 'IsLeapYear'.
Const ProcName As String = "InsertDateWorksheet"
Const First As String = "Initial"
Const Last As String = "Version"
Const Delimiter As String = "-"
Dim wb As Workbook: Set wb = ThisWorkbook
' First Worksheet
Dim fws As Worksheet: Set fws = RefWorksheet(wb, First, True)
If fws Is Nothing Then Exit Sub
If Not fws Is wb.Sheets(1) Then
fws.Move Before:=wb.Sheets(1)
End If
' Last Worksheet
Dim lws As Worksheet: Set lws = RefWorksheet(wb, Last, True)
If lws Is Nothing Then Exit Sub
Dim shCount As Long: shCount = wb.Sheets.Count
If Not lws Is wb.Sheets(shCount) Then
lws.Move After:=wb.Sheets(shCount)
End If
Dim NewDate As Date: NewDate = InputDateText(True)
If NewDate = 0 Then Exit Sub
Dim NewDateString As String: NewDateString = CStr(Day(NewDate)) _
& Delimiter & CStr(Month(NewDate)) & Delimiter _
& Right(CStr(Year(NewDate)), 2)
Dim nws As Worksheet: Set nws = RefWorksheet(wb, NewDateString)
If Not nws Is Nothing Then
MsgBox "The worksheet '" & NewDateString & "' already exists.", _
vbCritical, ProcName
Exit Sub
End If
Dim ws As Worksheet
Dim wsDate As Date
For Each ws In wb.Worksheets
Select Case ws.Name
Case First
Case Last
Exit For
Case Else
wsDate = GetTwoDigitYearDate(ws.Name, Delimiter)
If NewDate < wsDate Then
Exit For
End If
End Select
Next ws
Worksheets.Add(Before:=ws).Name = NewDateString
MsgBox "Worksheet '" & NewDateString & "' added.", vbInformation, ProcName
End Sub
Function RefWorksheet( _
ByVal wb As Workbook, _
ByVal WorksheetName As String, _
Optional ByVal DoWriteMessage As Boolean = False) _
As Worksheet
Const ProcName As String = "RefWorksheet"
On Error Resume Next
Set RefWorksheet = wb.Worksheets(WorksheetName)
On Error GoTo 0
If DoWriteMessage Then
If RefWorksheet Is Nothing Then
MsgBox "Worksheet '" & WorksheetName & "' not found.", _
vbCritical, ProcName
Exit Function
End If
End If
End Function
Function InputDateText( _
Optional ByVal DoWriteMessage As Boolean = False) _
As Date
' Needs 'GetTwoDigitYearDate' and 'IsLeapYear'.
Const ProcName As String = "InputDateText"
Const InputFormat As String = "d-m-yy"
Const nTitle As String = "Input Date Text"
Dim nPrompt As String
nPrompt = "Please enter a date in '" & InputFormat & "' format..."
Dim nDefault As String: nDefault = Format(Date, InputFormat)
Dim NewDateString As Variant: NewDateString = Application.InputBox( _
nPrompt, nTitle, nDefault, , , , , 2)
If NewDateString = False Then
MsgBox "You canceled.", vbExclamation, ProcName
Exit Function
End If
InputDateText = GetTwoDigitYearDate(NewDateString, "-")
If DoWriteMessage Then
If InputDateText = 0 Then
MsgBox "The string '" & NewDateString & "' is not valid.", _
vbCritical, ProcName
End If
End If
End Function
Function GetTwoDigitYearDate( _
ByVal DateString As String, _
Optional ByVal Delimiter As String = "-") _
As Date
' Needs 'IsLeapYear'.
On Error GoTo ClearError
Dim ArrDate() As String: ArrDate = Split(DateString, Delimiter)
Dim nYear As Long: nYear = CLng(ArrDate(2))
Select Case nYear
Case Is < 0, Is > 99
Exit Function
Case Else
nYear = IIf(nYear > 29, nYear + 1900, nYear + 2000)
End Select
Dim nMonth As Long: nMonth = CLng(ArrDate(1))
Select Case nMonth
Case Is < 1, Is > 12
Exit Function
End Select
Dim nDay As Long: nDay = CLng(ArrDate(0))
Select Case nDay
Case Is < 1, Is > 31
Exit Function
End Select
Select Case nMonth
Case 4, 6, 9, 11
If nDay = 31 Then Exit Function
Case 2
If nDay > 29 Then Exit Function
If nDay = 29 Then
If Not IsLeapYear(nYear) Then Exit Function
End If
End Select
GetTwoDigitYearDate = DateSerial(nYear, nMonth, nDay)
ProcExit:
Exit Function
ClearError:
Resume ProcExit
End Function
Function IsLeapYear( _
TestYear As Long) _
As Boolean
If TestYear Mod 4 = 0 Then
If TestYear Mod 100 = 0 Then
If TestYear Mod 400 = 0 Then
' Accounting for e.g. years 2000, 2400, 2800...8800, 9200, 9600.
IsLeapYear = True
'Else
' Accounting for e.g. years 2100, 2200, 2300...9700, 9800, 9900.
'isLeapYear = False
End If
Else
' Accounting for e.g. years 1904, 1908, 1912...1988, 1992, 1996.
IsLeapYear = True
End If
'Else
' Accounting for e.g. years 1901, 1902, 1903...1997, 1998, 1999.
'isLeapYear = False
End If
End Function
From ActiveWorkbook.name, I would like to extract the strings that are before (left side of ) the numbers. Since I want to use the same code in multiple workbooks, the file names would be variable, but every file name has date info in the middle (yyyymmdd).
In case of excel file, I can use the below formula, but can I apply the same kind of method in VBA?
=LEFT(A1,MIN(FIND({0,1,2,3,4,5,6,7,8,9},ASC(A1)&1234567890))-1)
Example: MyExcelWorkbook_Management_20200602_MyName.xlsm
In above case, I want to extract "MyExcelWorkbook_Management_".
The most basic thing you could do is to replicate something that worked for you in Excel through Evaluate:
Sub Test()
Dim str As String: str = "MyExcelWorkbook_Management_20200602_MyName.xlsm"
Debug.Print Evaluate(Replace("=LEFT(""X"",MIN(FIND({0,1,2,3,4,5,6,7,8,9},ASC(""X"")&1234567890))-1)", "X", str))
End Sub
Pretty? Not really, but it does the job and got it's limitations.
You could use Regular Expressions to extract any letters / underscores before the number as well
Dim str As String
str = "MyExcelWorkbook_Management_20200602_MyName.xlsm"
With CreateObject("vbscript.regexp")
.Pattern = "^\D*"
.Global = True
MsgBox .Execute(str)(0)
End With
Gives:
MyExcelWorkbook_Management_
So basically you want to use the Midfunction to look for the first numerical character in your input string, and then cut your input string to that position.
That means we need to loop through the string from left to right, look at one character at a time and see if it is a digit or not.
This code does exactly that:
Option Explicit
Sub extratLeftText()
Dim someString As String
Dim result As String
someString = "Hello World1234"
Dim i As Long
Dim c As String 'one character of your string
For i = 1 To Len(someString)
c = Mid(someString, i, 1)
If IsNumeric(c) = True Then 'should write "If IsNumeric(c) = True AND i>1 Then" to avoid an "out of bounds" error
result = Left(someString, i - 1)
Exit For
End If
Next i
MsgBox result
End Sub
Last thing you need to do is to load in some workbook name into your VBA function. Generally this is done with the .Name method of the workbookobject:
Sub workbookName()
Dim wb As Workbook
Set wb = ActiveWorkbook
MsgBox wb.Name
End Sub
Of course you would need to find some way to replace the Set wb = ActiveWorkbook line with code that suits your purpose.
I'm actually trying to code the sumproduct VBA script but I'm getting the runtime 13 error...
VBA:
Option Explicit
Sub sample_sumpro()
Dim cal_date, nxt_date As Date
cal_date = #12/30/2016#
nxt_date = cal_date + 1
Dim name As String, ws As Sheets
name = "Kawale, Amar"
Dim dm_daily As String
With Sheets(1)
dm_daily = Application.Evaluate("SUMPRODUCT((Columns(16)=name)*Columns(4)>=cal_date)*Columns(4)<nxt_date))")
End With
MsgBox dm_daily
End Sub
In a comment to another answer, you say that you are actually trying to do a count with two criteria (or three criteria according to the question). That is better achieved with Excel's CountIfs function, which can be coded in VBA using something like:
Option Explicit
Sub sample_sumpro()
Dim cal_date As Date, nxt_date As Date
Dim name As String
Dim dm_daily As String
cal_date = #12/30/2016#
nxt_date = cal_date + 1
name = "Kawale, Amar"
With Sheets(1)
dm_daily = Application.WorksheetFunction.CountIfs(.Columns(16), name, _
.Columns(4), ">=" & CDbl(cal_date), _
.Columns(4), "<" & CDbl(nxt_date))
End With
MsgBox dm_daily
End Sub
I didn't get exactly what you're trying to do, but if (just a guess) you're trying to evaluate the SUMPRODUCT of columns 14 and 15, you might want to try this:
Sub TestEvaluate()
Dim ws As Worksheet, x As String
Set ws = Worksheets(2)
x = Evaluate("sumproduct(" & ws.Columns(14).Address & "," & ws.Columns(15).Address & ")")
MsgBox x
End Sub
I have a sheet that has names, SSNs and 4 columns filled with the following values: S, MB, B.
For said columns I wish to replace S with the number 4, MB with the number 3 and B with the number 2.
Sub replace()
Dim str1, str2, str3, filename, pathname As String
Dim i As Integer
str1 = "MB"
str2 = "B"
str3 = "S"
filename = "p"
pathname = ActiveWorkbook.Path
i = 1
Do While filename <> ""
Set wb = Workbooks.Open(pathname & filename + i)
DoWork wb
wb.Close SaveChanges:=True
filename = Dir()
Loop
End Sub
Sub DoWork(wb As Workbook)
With wb
End With
End Sub
In the function DoWork, how do I create a loop to replace each of the values?
I mostly agree with Michael--to learn the most, you should get started on your own, and come back with more specific questions. However, I am looking to reach 50 rep so I will pander to you. But do please try to go through the code and understand it.
Your name suggests you are a programmer, so the concepts we make use of should be familiar. I like to work from the inside out, so here goes:
here are my variables:
Dim sFileName As String
Dim sFilePath As String
Dim wbBook As Excel.Workbook
Dim i As Double
Dim wsSheet As Excel.Worksheet
Dim rRange As Range
Dim c As Range
Dim dReplace As Double
At the core, you'll want a select case statement to read each cell and decide what the new value should be. Then you will assign the new value to the cell:
Select Case c.value 'c being the cell we are currently examining
Case "S"
dReplace = 4
Case "M"
dReplace = 3
Case "B"
dReplace = 2
Case Else
'Assuming you should only encounter the above values,
'then anything else is an error
'.assert false will stop the code, or you can replace
'with more refined error handling
Debug.Assert False
End Select
c.value = dReplace
Around that you'll want a for each loop to define the current cell and iterate through all the cells in the range you specify for that particular worksheet:
set rRange = wsSheet.Range("C2:E5000") 'Customize to your range
for each c in rRange.Cells
'...
next
Next level up is the for next loop to iterate through all the worksheets in the current file:
For i = 1 To 30
If wbBook.Sheets(i).Name = "" Then
GoTo NextOne
End If
Set wsSheet = wbBook.Sheets(i)
'...
NextOne:
Next i
The if then statement at the top prevents an error if there are fewer than 30 worksheets in a workbook. If the number of sheets per file varies then this will be useful, if the number is fixed, just adjust the loop to stop and the right spot. Of course, this assumes your workbooks have information on multiple sheets. If not skip the loop altogether.
I'm sure many will criticize my use of goto, but since VBA loops lack a continue command, this is the workaround I employ.
Around that you'll want another iterator to loop through your multiple files. Assuming they are all in the same folder, you can use the Dir() function to grab the file names one-by-one. You give it the file path and (optionally) the file type, and it will return the first file name it finds that meets your cirteria. Run it again and it returns the second file name, etc. Assign that to a string variable, then use the file path plus the file name to open the workbook. Use a do loop to keep going until runs out of files:
sFilePath = "C:\Your File Path Here\"
sFileName = Dir(sFilePath & "*.xlsx")
Do Until sFileName = ""
Set wbBook = Workbooks.Open(sFilePath & sFileName)
'...
wbBook.Save
wbBook.Close
sFileName = Dir()
Loop
Now Put it all together:
Sub ReplaceLetterCodewithNumberCode()
Dim sFileName As String
Dim sFilePath As String
Dim wbBook As Excel.Workbook
Dim i As Double
Dim wsSheet As Excel.Worksheet
Dim rRange As Range
Dim c As Range
Dim dReplace As Double
Application.ScreenUpdating = False
sFilePath = "C:\Your File Path Here\"
sFileName = Dir(sFilePath & "*.xlsx")
Do Until sFileName = ""
Set wbBook = Workbooks.Open(sFilePath & sFileName)
For i = 1 To 30
If wbBook.Sheets(i).Name = "" Then
GoTo NextOne
End If
Set wsSheet = wbBook.Sheets(i)
Set rRange = wsSheet.Cells("C2:E5000") 'Customize to your range. Assumes the range will be the same
For Each c In rRange.Cells
Select Case c.value 'c being the cell we are currently examining
Case "S"
dReplace = 4
Case "M"
dReplace = 3
Case "B"
dReplace = 2
Case Else
'Assuming you should only encounter the above values,
'then anything else is an error
'.assert false will stop the code, or you can replace
'with more refined error handling
Debug.Assert False
End Select
c.value = dReplace
Next
NextOne:
Next i
wbBook.Save
wbBook.Close
sFileName = Dir()
Loop
'Clean up
Set wbBook = Nothing
Set wsSheet = Nothing
Set rRange = Nothing
Set c = Nothing
Application.ScreenUpdating = True
End Sub
I'll provide a high level explanation of this; implementation will be up to you. You'll start with a crawler to open all of these files one by one (a google search should help you with this).
I'm not exactly sure how your sheets are organized but the general idea is to open each sheet and perform the action, so you'll need a list of filenames/paths or do it sequentially. Then once inside the file assuming the structure is the same of each you'll grab the column and input the appropriate value then save and close the file.
If you're looking for how to open the VBA editor go to options and enable the Developer tab.
This is a good beginner project and while you may struggle you'll learn a lot in the process.