Forum Discussion

JoeCavasin's avatar
JoeCavasin
Brass Contributor
Jul 30, 2023
Solved

Excel VBA - Define Range of rows from known static range as start to flexible range address as end

Need help with an Excel VBA process.  Below is a screenshot of the current logic with the intended goal noted in the red box.  Can someone assist with helping me set criteria to define the range or r...
  • HansVogelaar's avatar
    HansVogelaar
    Mar 06, 2025

    Please test this version carefully:

    Sub CreateNewUserTab11184()
        Dim WBK As Workbook
        Dim WSH As Worksheet
        Dim RNG1 As Range
        Dim RNG2 As Range
        Dim ADR1 As String
        Dim ADR2 As String
        Dim WSN As Worksheet
        Dim ID As Long
        Dim RowStart As String
        Dim RowEnd As String
        Dim EndAddress As String
        Dim StartAddress As String
        Dim StartMonth As Date
        Dim EndMonth As Date
        Dim StartRow As String
        Dim LR As Long
    
    
    'Save and close other workbooks
        For Each WBK In Application.Workbooks
            If Not (WBK Is Application.ThisWorkbook) Then
                WBK.Close SaveChanges:=True
            End If
        Next WBK
    'Find New Users on Productivity Tab
        Application.ScreenUpdating = True
        Set WBK = ThisWorkbook
        Set WSH = WBK.Worksheets("User List")
        With WSH.Range("F:F")
            Set RNG1 = .Find(What:="No", LookIn:=xlValues, Lookat:=xlWhole)
            If Not RNG1 Is Nothing Then
                Do
                    ADR1 = RNG1.Address
                    Set RNG2 = RNG1.Offset(0, -5)
                    ADR2 = RNG2.Address
                    If RNG2.Value <> "" Then
                        ID = RNG2.Value
                        StartMonth = RNG1.Offset(0, 1).Value
                'Copy template to end of sheets
                        WBK.Worksheets("Template").Copy After:=WBK.Worksheets(WBK.Worksheets.Count)
                        Set WSN = WBK.Worksheets(WBK.Worksheets.Count)
                'Update ID Cell and Tab Name on new sheet
                        WSN.Range("B8").Value = ID
                        WSN.Name = CStr(ID)
                'Identify future month rows to remove
                        'WSN.Range("A11") = RowStart
                        If RNG1.Offset(0, 2).Value <> "" Then
                            EndMonth = RNG1.Offset(0, 2).Value
                            EndAddress = Cells(WorksheetFunction.Match(CLng(EndMonth), Range("A:A"), 0), 1).Address
                            RowEnd = Range(EndAddress).Row
                            WSN.Range("A11:A" & RowEnd - 1).EntireRow.Delete
                        End If
                'Identify pre-start month rows to remove
                        StartAddress = Cells(WorksheetFunction.Match(CLng(StartMonth), Range("A:A"), 0), 1).Address
                        RowStart = Range(StartAddress).Row
                        LR = Cells(Rows.Count, 1).End(xlUp).Row
                        WSN.Range("A" & RowStart + 1 & ":A" & LR).EntireRow.Delete
                'Update New Sheet Caluclation References
                        WSN.Range("B1").Formula = "=B9"
                        WSN.Range("B3").Formula = "=SUM(G9,J9,N9)"
                        WSN.Range("B5").Formula = "=Q9"
                        WSN.Range("B9").Formula = "=SUM($AL$11:$AL$33)"
                        WSN.Range("G9").Formula = "=SUM($AO$11:$AO$33)"
                        WSN.Range("J9").Formula = "=SUM($AM$11:$AM$33)"
                        WSN.Range("N9").Formula = "=SUM($AN$11:$AN$33)"
                        WSN.Range("Q9").Formula = "=SUM($AK$11:$AK$21)"
                        WSN.Range("T9").Formula = "=SUM($AI$11:$AI$33)"
                        WSN.Range("Y9").Formula = "=SUM($AH$11:$AH$33)"
                        WSN.Range("AB9").Formula = "=SUM($AJ$11:$AJ$33)"
                        WSN.Range("AH11").Formula = "=COUNTIF($B11:$AF11,""B"")"
                        WSN.Range("AI11").Formula = "=SUMPRODUCT(VALUE($AR11:$BV11))"
                        WSN.Range("AJ11").Formula = "=COUNTIF($B11:$AF11,""=""&""J"")"
                        WSN.Range("AK11").Formula = "=COUNTIF($DD11:$EH11,""=""&""1"")"
                        WSN.Range("AL11").Formula = "=COUNTIF($EJ11:$FN11,""=""&""1"")"
                        WSN.Range("AM11").Formula = "=SUM(FP11:GT11)"
                        WSN.Range("AN11").Formula = "=SUM(IB11:JF11)"
                        WSN.Range("AO11").Formula = "=SUM(GV11:HZ11)"
                        WSN.Range("AK23").Formula = "=IF(AND(SUM($DD23:$EH23)>0,SUM($AK11:$AK21)=0),0,SUM($DD23:$EH23))"
                        WSN.Range("AM23").Formula = "=IF(AND(SUM(FP23:GT23)>0,SUM(AM11:AO21)=0),0,SUM(FP23:GT23))"
                        WSN.Range("AN23").Formula = "=IF(AND(SUM(IB23:JF23)>0,SUM(AM11:AO21)=0),0,SUM(IB23:JF23))"
                        WSN.Range("AO23").Formula = "=IF(AND(SUM(GV23:HZ23)>0,SUM(AM11:AO21)=0),0,SUM(GV23:HZ23))"
                        WSN.Rows("35:36").EntireRow.Copy
                        WSN.Rows("35:36").EntireRow.PasteSpecial xlPasteValues
                'Update User List to create links to newly created user tabs
                        WSH.Hyperlinks.Add Anchor:=RNG2, Address:="", SubAddress:="'" & WSN.Name & "'!A1"
                    End If
                    'RNG1.Value = "Yes"
                    Set RNG1 = .Find(What:="No", Lookat:=xlWhole)
                    If RNG1 Is Nothing Then Exit Do
                Loop Until RNG1.Address = ADR1
            End If
        End With
        WSH.Activate
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
    End Sub

     

Resources