I have table where I track documents that have been created and documents that have been requested to be created. For the new documents I assign a control number, but I can’t see it clearly enough to avoid repeating the numbers, so I am trying to separate the different types of documents out and further split them based on the type of device being documented and the specific subject being documented. I also need the numbers that are not sequential to leave a blank space, as the control numbers need to stay the same across each device only differentiating by the device unique identifier. I have defined what each part of the control number designates in my code and assigned a column for each truck/subject combination.
Sub AssignValuesAndCopy()
Dim ws As Worksheet
Dim sourceCell As Range
Dim firstPart As String
Dim middlePart As String
Dim lastPart As String
Dim assignedValue As String
Dim otherItem As String
Dim targetSheet As Worksheet
Dim targetColumn As Long
Dim sequentialStart As Long
' Set the worksheet (change "Sheet2" to your actual sheet name)
Set ws = ThisWorkbook.Sheets("Documents")
' Find the last used row in column B
lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
' Loop through each row
For i = 1 To lastRow
Set sourceCell = ws.Cells(i, 2) ' Column B
parts = Split(sourceCell.Value, “-“)
‘ Extract the first, middle, and last parts
firstPart = Split(sourceCell.Value, “-“)(0)
‘ Extract the middle part (if it exists)
If UBound(parts) >= 1 Then
middlePart = parts(1)
Else
middlePart = “” ‘ Handle cases where there is no middle part
End If
‘ Extract the last part (if it exists)
If UBound(parts) >= 2 Then
lastPart = parts(2)
Else
lastPart = “” ‘ Handle cases where there is no last part
End If
' Assign values based on the first part
Select Case firstPart
Case "INS"
assignedValue = "INS"
Case "RTF"
assignedValue = "RTF"
Case "SFT"
assignedValue = "SFT"
Case "SPT"
assignedValue = "SPT"
Case "SVC"
assignedValue = "SVC"
Case "TNG"
assignedValue = "TNG"
Case "TST"
assignedValue = "TST"
Case "WKI"
assignedValue = "WKI"
End Select
' Assign values based on the middle part
Select Case middlePart
Case "T20"
assignedValue = "1"
Case "D20"
assignedValue = "2"
Case "H20"
assignedValue = "3"
Case "T23"
assignedValue = "5"
Case "D23"
assignedValue = "6"
Case "H23"
assignedValue = "7"
Case "T26"
assignedValue = "9"
Case "D26"
assignedValue = "10"
Case "H26"
assignedValue = "11"
Case "T28"
assignedValue = "13"
Case "D28"
assignedValue = "14"
Case "H28"
assignedValue = "15"
Case "T30"
assignedValue = "17"
Case "D30"
assignedValue = "18"
Case "H30"
assignedValue = "19"
Case "T38"
assignedValue = "21"
Case "D38"
assignedValue = "22"
Case "H38"
assignedValue = "23"
Case "T53"
assignedValue = "25"
Case "D53"
assignedValue = "26"
Case "H53"
assignedValue = "27"
Case "T56"
assignedValue = "29"
Case "D56"
assignedValue = "30"
Case "H56"
assignedValue = "31"
Case "T60"
assignedValue = "33"
Case "D60"
assignedValue = "34"
Case "H60"
assignedValue = "35"
Case "T61"
assignedValue = "37"
Case "D61"
assignedValue = "38"
Case "H61"
assignedValue = "39"
Case "T62"
assignedValue = "41"
Case "D62"
assignedValue = "42"
Case "H62"
assignedValue = "43"
Case "T65"
assignedValue = "45"
Case "D65"
assignedValue = "46"
Case "H65"
assignedValue = "47"
Case "T66"
assignedValue = "49"
Case "D66"
assignedValue = "50"
Case "H66"
assignedValue = "51"
Case "T70"
assignedValue = "52"
Case "D70"
assignedValue = "53"
Case "H70"
assignedValue = "54"
Case "T80"
assignedValue = "5"
Case "D80"
assignedValue = "58"
Case "H80"
assignedValue = "59"
End Select
' Determine the target sheet based on the first value
Set targetSheet = ThisWorkbook.Sheets(firstPart) ' Assumes sheet names match assigned values
' Set the target column (e.g., column B)
targetColumn = Val(middlePart)
' Copy the assigned value to the specified target sheet and column
targetSheet.Cells(1, targetColumn).Value = assignedValue
Next i
MsgBox "Values assigned and copied successfully!"
End Sub
Aidan L is a new contributor to this site. Take care in asking for clarification, commenting, and answering.
Check out our Code of Conduct.