bongpsumera
06-25-2017, 11:02 PM
Hi,
I'm not sure if this has been covered but I'm looking everywhere for a short piece of VBA code to create named ranges from the columns off a sheet and include the sheet name as a prefix for the named range.
I've managed to find the following:
Dim wbk As Workbook
Dim Sht As Worksheet
Dim rng6, rng7 As Range
Dim cl As Object
Dim c As Long
Dim strAddr As Variant
Dim strShName, strHdrName, strCol As String
Set wbk = ActiveWorkbook
Set Sht = Sheets("Raw")
c = Sht.Cells.SpecialCells(xlLastCell).Column
Set rng6 = Sht.Range("A1", Sht.Range("A1").Offset(0, c))
For Each cl In rng6
If cl.Value <> "" Then
strShName = Replace(Sht.Name, " ", "_", 1)
strHdrName = Replace(cl.Value, " ", "_", 1)
strAddr = Split(cl.Address, "$")
strCol = "$" & strAddr(1) & ":$" & strAddr(1)
Set rng7 = Sht.Range(cl, cl.End(xlDown))
ActiveWorkbook.Names.Add Name:=strShName & strHdrName, _
RefersTo:="=OFFSET('" & Sht.Name & "'!" & cl.Address & ",0,0,COUNTA('" & _
Sht.Name & "'!" & strCol & "),1)"
End If
Next cl
But if there are blank cells in a column it seems to shorten the range in the column (I suspect this has to do with the COUNTA offset).
The last row for each of the ranges should be determined from the last row in column A.
i.e.
Dim lastrow As Long
lastrow = Range("A655636").End(xlUp).Row
Any assistance would be greatly appreciated.
I'm not sure if this has been covered but I'm looking everywhere for a short piece of VBA code to create named ranges from the columns off a sheet and include the sheet name as a prefix for the named range.
I've managed to find the following:
Dim wbk As Workbook
Dim Sht As Worksheet
Dim rng6, rng7 As Range
Dim cl As Object
Dim c As Long
Dim strAddr As Variant
Dim strShName, strHdrName, strCol As String
Set wbk = ActiveWorkbook
Set Sht = Sheets("Raw")
c = Sht.Cells.SpecialCells(xlLastCell).Column
Set rng6 = Sht.Range("A1", Sht.Range("A1").Offset(0, c))
For Each cl In rng6
If cl.Value <> "" Then
strShName = Replace(Sht.Name, " ", "_", 1)
strHdrName = Replace(cl.Value, " ", "_", 1)
strAddr = Split(cl.Address, "$")
strCol = "$" & strAddr(1) & ":$" & strAddr(1)
Set rng7 = Sht.Range(cl, cl.End(xlDown))
ActiveWorkbook.Names.Add Name:=strShName & strHdrName, _
RefersTo:="=OFFSET('" & Sht.Name & "'!" & cl.Address & ",0,0,COUNTA('" & _
Sht.Name & "'!" & strCol & "),1)"
End If
Next cl
But if there are blank cells in a column it seems to shorten the range in the column (I suspect this has to do with the COUNTA offset).
The last row for each of the ranges should be determined from the last row in column A.
i.e.
Dim lastrow As Long
lastrow = Range("A655636").End(xlUp).Row
Any assistance would be greatly appreciated.