Function createDynamicNamedRange(sSheetName As String, sNameRange As String) As Boolean
'--------------------------------------------------------------------------------------
'# Áp dung cho mot Named Range da thiet lap truoc, hàm chi cap nhat dong cho so dòng cua range.
'# Dùng cho Named Range có dong tieu de va khong có dòng tieu de.
'# Khi gap NR 'không có' dòng tiêu de, khi thuc hien xóa toàn bo range (.ClearCntents): phai xet xem no có Empty không
'# de xác dinh dòng dau, dòng cuoi tao range dè len dòng tiêu de.
'--------------------------------------------------------------------------------------
Dim sht As Worksheet
Dim lngFirstRowRng As Long
Dim lngLastRowRng As Long
Dim lngFirstColRng As Long
Dim lngLastColRng As Long
Dim strColumnLetter As String
Dim myDynamicNamedRange As Range
Set sht = ThisWorkbook.Sheets(sSheetName)
'Khai bao dòng/côt dau tiên cua Range
lngFirstRowRng = sht.Range(sNameRange).Row
lngFirstColRng = GetFirstColumn(sSheetName, sNameRange)
strColumnLetter = ConvertToLetter(lngFirstColRng)
With sht.Cells
If WorksheetFunction.Count(Range(sNameRange)) = 0 Then 'neu range dang empty (khong có dong tieu de)
lngLastRowRng = sht.Cells(Rows.Count, strColumnLetter).End(xlUp).Row + 1
lngLastColRng = GetLastColumn(sSheetName, sNameRange)
Else
lngLastRowRng = sht.Cells(Rows.Count, strColumnLetter).End(xlUp).Row
lngLastColRng = GetLastColumn(sSheetName, sNameRange)
End If
Set myDynamicNamedRange = .Range(.Cells(lngFirstRowRng, lngFirstColRng), .Cells(lngLastRowRng, lngLastColRng))
End With
ThisWorkbook.Names.Add Name:=sNameRange, RefersTo:=myDynamicNamedRange
End Function
'----------------------------------------------------------------
'# Hàm lay dong cuoi dua tren [Name Range]
'# Dung duoc trong truong hop dong dau cua Range khong phai tu 1
'----------------------------------------------------------------
Function GetLastRow(sSheetName As String, sNameRange As String) As Long
Dim sht As Worksheet
Dim FirstRow As Long
Dim LastRow As Long
Set sht = ThisWorkbook.Sheets(sSheetName)
FirstRow = sht.Range(sNameRange).Row
LastRow = sht.Range(sNameRange).Rows.Count + FirstRow - 1
GetLastRow = LastRow
End Function
Function GetFirstColumn(sSheetName As String, sNameRange As String) As Long
Dim sht As Worksheet
Dim FirstCol As Long
Set sht = ThisWorkbook.Sheets(sSheetName)
FirstCol = sht.Range(sNameRange).Column
GetFirstColumn = FirstCol
End Function
Function GetLastColumn(sSheetName As String, sNameRange As String) As Long
Dim sht As Worksheet
Dim LastCol As Long
Set sht = ThisWorkbook.Sheets(sSheetName)
LastCol = sht.Range(sNameRange).Columns(sht.Range(sNameRange).Columns.Count).Column
GetLastColumn = LastCol
End Function
Function ConvertToLetter(iCol As Long) As String
'---------------------------------------------
'# Hàm chuyen so thu tu cot thanh ten Alphabe
'---------------------------------------------
Dim iAlpha As Integer
Dim iRemainder As Integer
iAlpha = Int(iCol / 27)
iRemainder = iCol - (iAlpha * 26)
If iAlpha > 0 Then
ConvertToLetter = Chr(iAlpha + 64)
End If
If iRemainder > 0 Then
ConvertToLetter = ConvertToLetter & Chr(iRemainder + 64)
End If
End Function
