Unfortunately, I'm unable to download/use XL2BB anymore so only have text and screen shots.
The following macro all of a sudden started returning erroneous results without any changes to it, so I'm hoping someone can spot in the code where this might be occurring. This macro assigns a named range starting in Column D of Rows 5-64 within the Product Completion By Month tab. As you can see in the first screenshot, PCBM1 should refer to D5, but in reality when I select the D5 cell and open the Name Manager it has assigned G5 as the defined name (and E5 = H5, F5 = I5 etc. across the columns) per the second screenshot. It doesn't matter what cell my cursor is in when I run the macro it returns the same erroneous results. These errors ultimately impact (pass false data to) another tab in my workbook that's critical for my tax reporting. Any help is greatly appreciated.
The following macro all of a sudden started returning erroneous results without any changes to it, so I'm hoping someone can spot in the code where this might be occurring. This macro assigns a named range starting in Column D of Rows 5-64 within the Product Completion By Month tab. As you can see in the first screenshot, PCBM1 should refer to D5, but in reality when I select the D5 cell and open the Name Manager it has assigned G5 as the defined name (and E5 = H5, F5 = I5 etc. across the columns) per the second screenshot. It doesn't matter what cell my cursor is in when I run the macro it returns the same erroneous results. These errors ultimately impact (pass false data to) another tab in my workbook that's critical for my tax reporting. Any help is greatly appreciated.
VBA Code:
Public Sub subCreateNamedRanges()
' https://www.mrexcel.com/board/threads/autofill-naming-defined-names.1234019/
Dim Ws As Worksheet
Dim strMsg As String
Dim rngRangeList As Range
Dim Rng As Range
Dim s As String
Dim NamedRange As Name
Dim strName As String
Dim blnSheet As Boolean
Dim rngAddress As Range
Dim intRow As Integer
Dim strColumns As String
Dim strCodes As String
Dim i As Integer
Dim arrColumns() As String
Dim arrCodes() As String
Dim WsList As Worksheet
Dim intCount As Integer
ActiveWorkbook.Save
strMsg = "Do you want to set the named ranges for the '" & ActiveSheet.Name & "' worksheet?"
If MsgBox(strMsg, vbYesNo, "Security Question") = vbNo Then
MsgBox "Activate the correct sheet before you run this code.", vbOKOnly, "Information"
Exit Sub
End If
Set Ws = ActiveSheet
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("NamedRangeList1234019").Delete
Application.DisplayAlerts = True
On Error GoTo 0
Worksheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "NamedRangeList1234019"
Set WsList = ActiveSheet
WsList.Range("A2:F20000").Cells.ClearContents
Ws.Activate
strColumns = "D"
arrColumns = Split(strColumns, ",")
strCodes = Replace("PCBM", " ", "", 1)
arrCodes = Split(strCodes, ",")
For i = LBound(arrColumns) To UBound(arrColumns)
For intRow = 1 To 60
strName = arrCodes(i) & intRow
Set rngAddress = Ws.Cells(4 + intRow, Range(Trim(arrColumns(i)) & "1").Column)
With WsList
.Range("A" & Rows.Count).End(xlUp)(2) = strName
.Range("B" & Rows.Count).End(xlUp)(2) = "'" & Ws.Name & "!" & rngAddress.Address
End With
ThisWorkbook.Names.Add Name:=strName, RefersTo:="='" & rngAddress.Worksheet.Name & "'!" & rngAddress.Address(True, False)
intCount = intCount + 1
Next intRow
Next i
ActiveWorkbook.Save
WsList.Activate
With WsList.Range("A1").CurrentRegion
.Font.Size = 16
.Font.Name = "Arial"
.EntireColumn.AutoFit
.VerticalAlignment = xlCenter
With .Rows(1)
.Value = Array("Name", "Address")
.Font.Bold = True
.Interior.Color = RGB(219, 219, 219)
End With
.RowHeight = 28
With .Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = vbBlack
End With
.IndentLevel = 1
End With
WsList.Range("A2").Select
ActiveWindow.FreezePanes = True
strMsg = intCount & " named ranges have been created."
strMsg = strMsg & vbCrLf & "These have been listed in the " & WsList.Name & " worksheet."
MsgBox strMsg, vbInformation, "Confirmation"
End Sub
