Change value of a cell depending on worksheet name - excel

Question

I am trying to learn vba and I have this list. For every NAME there will be an individual worksheet created. If the name of the worksheet match the name on the list I need to put the length in cell J1. I tried to use if ... elseif ... but knowing I have 430 different names the code will be too long what should I do? What alternative code can I use?
Sub length()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name = "A" Then
ws.Activate
Range("J1").Select
ActiveCell.FormulaR1C1 = 4153
ElseIf ws.Name = "B" Then
ws.Activate
Range("J1").Select
ActiveCell.FormulaR1C1 = 2273
Next
MsgBox "DONE"
End Sub

Answer 1

Sub length()
Dim Cell as Range
For Each Cell In Range("Name")
On Error Resume Next
ThisWorkbook.Sheets(Cell.Value).Range("J1") = Cell.Offset(0, 1)
If Err.Number <> 0 Then Debug.Print "Sheet " & Cell & " wasn't found"
On Error GoTo 0
Next Cell
MsgBox "DONE"
End Sub
Range("Name") needs to be changed to refer to the real range with the sheet names.
On Error ... can be removed if you're sure that all mentioned worksheets exist.

Answer 2

Write Values to Worksheets From a List
This will loop through the list of names. There may be worksheets whose names are not on the list.
Adjust the name of the worksheet containing the list (Sheet1) and the column (A) and row (2) of the first name.
Option Explicit
Sub CopyLengths()
' Reference the workbook ('wb').
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Reference the source worksheet ('sws').
Dim sws As Worksheet: Set sws = wb.Worksheets("Sheet1")
' Calculate the last row ('slRow'), the row of the last non-empty cell
' in the worksheet names column.
Dim slRow As Long: slRow = sws.Cells(sws.Rows.Count, "A").End(xlUp).Row
' Reference the source range ('srg'), the one-column range
' containing the worksheet names.
Dim srg As Range: Set srg = sws.Range("A2", sws.Cells(slRow, "A"))
Dim dws As Worksheet ' Destination Worksheet
Dim sCell As Range ' Current Source (Name) Cell
Dim sString As String ' Current Source String
' Copy lenghts.
' Loop through the cells ('sCell') of the source range...
For Each sCell In srg.Cells
' Convert the current cell's value to a string ('CStr')
' and write the string to a variable ('sString').
sString = CStr(sCell.Value)
' Check if the string is not an empty string...
If Len(sString) > 0 Then ' the cell is not blank
' Attempt to reference the worksheet named after the string.
On Error Resume Next
Set dws = wb.Worksheets(sString)
On Error GoTo 0
If Not dws Is Nothing Then ' worksheet found (referenced)
' Copy (write) the length.
dws.Range("J1").Value = sCell.Offset(, 1).Value
Set dws = Nothing ' reset the variable
'Else ' worksheet not found (not referenced); do nothing or e.g. ...
'Debug.Print "Worksheet '" & sString & "' not found"
End If
'Else ' the cell is blank; do nothing
End If
Next sCell
' Inform.
MsgBox "Lengths copied.", vbInformation
End Sub

Answer 3

Sub UpdateSheets()
Dim vTable As Variant
Dim iRow As Long
' SHEET_NAME: The sheets name containing the table: Name, LENGTH
' RANGE: the range where the sheet names are listed (without the header)
' vTable: the table with 'Name' & 'LENGTH' column values in memory
vTable = ThisWorkbook.Worksheets("SHEET_NAME").Range("I2:J7").Value2
For iRow = LBound(vTable, 1) To UBound(vTable, 1) ' iRow: current row in table
' vTable(iRow, 1): 'Name' column value
' vTable(iRow, 2): 'LENGTH' column value
On Error Resume Next
ThisWorkbook.Worksheets(CStr(vTable(iRow, 1))).Range("J1").Value2 = vTable(iRow, 2)
On Error GoTo 0
If Err.Number <> 0 Then
' DO SOMETHING IF ERROR IS THROWN (CREATE MISSING WORKSHEET)
Err.Clear
End If
Next iRow
MsgBox "DONE"
End Sub
If you have any questions don't hesitate!
Cheers, Peter.

Answer 4

Assuming that the columns are as on the image, you can do this:
Sub fnPickLength()
Dim ws As Excel.Worksheet
Dim oCell As Excel.Range
Dim oRng As Excel.Range
Set oRng = Range("rngTheNames") 'name the range with this name
For Each ws In ThisWorkbook.Worksheets
For Each oCell In oRng
If UCase(ws.Name) = UCase(oCell.Value) Then
ws.Activate
Range("J1").Select
ActiveCell.FormulaR1C1 = oCell.Offset(0, 1).Value
Exit For
End If
Next
Next
MsgBox "DONE"
End Sub
Please adapt the named range as you want. I've choosen as "rngTheNames".
The ws name is compared with each oCell value. If matched, the Offset property reads the sibling cell of the evaluated name and put its value on the ws.