4
\$\begingroup\$

Update

Due to the fact that the client's version of excel does not support VBA, I have moved on to a C# excel interop solution which has been reviewed.

The test data has been added at the bottom. The test file including the macros can be found at https://github.com/pacmaninbw/Anza-Tenant-Roster/RentRosterActions.xlsm.

End Update

This Excel VBA program prints a list of apartment numbers with the name of the renter(s) for the mailbox for each building of the apartment complex I live in. The user (apartment managers assistant) can select to print a mailbox list for either a single building or all the buildings in the complex at once. I chose excel VBA because the renter roster is currently stored as an excel workbook rather than in a database.

I decided to do this for the apartment building because the mailbox list for my building is at least 2 years out of date.

For 5 buildings it runs in under 30 seconds.

It has been about 8 years since I wrote any VBA code, what could I do better?

Option Explicit
Dim AddressAndApts As Worksheet
Dim AddressRange As Range
Dim RentRosterSheet As String

Private Function LastRowInColumn(ByVal sht As Worksheet, ByVal CurrentColumn As Long) As Long

    LastRowInColumn = sht.Cells(sht.Rows.Count, CurrentColumn).End(xlUp).Row

End Function

Private Function LastColumnInRow(ByVal sht As Worksheet, ByVal CurretRow As Long) As Long

    LastColumnInRow = sht.Cells(1, sht.Columns.Count).End(xlToLeft).Column
    
End Function

Private Sub GetRenterData(CurrentColumn As Long, _
    FirstFloorCount As Integer, SecondFloorCount As Integer, ThirdFloorCount As Integer, _
    FirstFloor() As Variant, SecondFloor() As Variant, ThirdFloor() As Variant _
)
    Dim AptInfoInput As Worksheet
    Dim FoundCell As Range
    Dim LastRow, i As Long

    LastRow = LastRowInColumn(AddressAndApts, CurrentColumn)
    Const AptNumberOffset As Long = 2
    Const FirstRenterName As Long = 4
    Const CosignerName As Long = 6
    FirstFloorCount = 0
    SecondFloorCount = 0
    ThirdFloorCount = 0
        
    Set AptInfoInput = ThisWorkbook.Sheets("RenterRoster")
    
    With AptInfoInput
        For i = 0 To LastRow - 1
            Dim AptNumber As String
            Dim AptInfo As String
            AptNumber = AddressAndApts.Cells(i + AptNumberOffset, CurrentColumn)
            Set FoundCell = .Range("A:A").Find(What:=AptNumber)
            If Not FoundCell Is Nothing Then
                Dim AptInfoRow As Long
                AptInfoRow = FoundCell.Row
                AptInfo = .Cells(AptInfoRow, 1).Value & "  " & .Cells(AptInfoRow, FirstRenterName).Value
                If Not IsEmpty(.Cells(AptInfoRow, CosignerName)) Then
                    AptInfo = AptInfo & " // " & .Cells(AptInfoRow, CosignerName)
                End If
            End If
            If AptNumber < "200" Then
                FirstFloor(FirstFloorCount) = AptInfo
                FirstFloorCount = FirstFloorCount + 1
            Else
                If AptNumber < "300" Then
                    SecondFloor(SecondFloorCount) = AptInfo
                    SecondFloorCount = SecondFloorCount + 1
                Else
                ' Add spaces to the begining to offset the third floor from the first floor
                    ThirdFloor(ThirdFloorCount) = "                                        " _
                        & AptInfo
                    ThirdFloorCount = ThirdFloorCount + 1
                End If
            End If
                
        Next i
    End With

End Sub

Private Function FillOutputSheet(ByVal SheetName As String, _
    ByVal FirstFloorCount As Integer, ByVal SecondFloorCount As Integer, ByVal ThirdFloorCount As Integer, _
    FirstFloor() As Variant, SecondFloor() As Variant, ThirdFloor() As Variant _
) As Integer

    Dim OutputSheet As Worksheet
    Dim Max1st2nd As Integer
    Dim Row As Integer
    Dim i As Integer
    
    Set OutputSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    OutputSheet.Name = SheetName
    OutputSheet.Cells(1, 1).Value = SheetName
    
    Max1st2nd = FirstFloorCount
    If FirstFloorCount < SecondFloorCount Then
        Max1st2nd = SecondFloorCount
    End If
    
    Row = 2
    For i = 0 To Max1st2nd - 1
        OutputSheet.Cells(Row, 1).Value = FirstFloor(i)
        OutputSheet.Cells(Row, 2).Value = SecondFloor(i)
        Row = Row + 1
    Next i
    
    Row = Row - 1
    FillOutputSheet = Row
    For i = 0 To ThirdFloorCount - 1
        OutputSheet.Cells(Row, 1).Value = ThirdFloor(i)
        Row = Row + 1
    Next i
    
End Function

Private Sub FormatOutputSheet(SheetName As String, ByVal StartThirdFloor As Integer, _
    ByVal ThirdFloorCount As Integer)

    Dim OutputSheet As Worksheet
    Dim OutputDataRange, TitleRange, OutputThirdFloor As Range
    Dim OutputDataRangeValue, OutputThirdFloorRangeValue As String
    
    OutputDataRangeValue = "A2:B" & (StartThirdFloor - 1)
    OutputThirdFloorRangeValue = "A" & StartThirdFloor & ":B60"
    Set OutputSheet = ThisWorkbook.Sheets(SheetName)
    Set OutputDataRange = OutputSheet.Range(OutputDataRangeValue)
    Set OutputThirdFloor = OutputSheet.Range(OutputThirdFloorRangeValue)
    Set TitleRange = OutputSheet.Range("A1:B1")
    
    Const ColumnWidth As Double = 43
    Const DataRowHeight As Double = 26
    
    OutputSheet.PageSetup.TopMargin = Application.InchesToPoints(0.5)
    OutputSheet.PageSetup.BottomMargin = Application.InchesToPoints(0.5)
    
    With OutputSheet.Range("A1:B60")
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .Font.Size = 12
        .Font.Bold = True
        .ColumnWidth = ColumnWidth
    End With
    
    With TitleRange
        .HorizontalAlignment = xlCenter
        .MergeCells = True
        .Font.Size = 70
        .Font.Bold = True
    End With

    With OutputDataRange
        .Cells.WrapText = True
        .ColumnWidth = ColumnWidth
        .RowHeight = DataRowHeight
    End With
    
    With OutputThirdFloor
        .Cells.WrapText = True
        .RowHeight = DataRowHeight
    End With
    
    Dim i As Integer
    For i = 0 To ThirdFloorCount - 1
        Dim RangeValue As String
        Dim Row As Integer
        Row = StartThirdFloor + i
        RangeValue = "A" & Row & ":B" & Row
        OutputSheet.Range(RangeValue).MergeCells = True
    Next i

End Sub
' This subroutine will create and print 1 mailbox list
' It can becalled in a loop to print all the mailbox lists
Private Sub CreatePrintDeleteMailboxList(ByVal CurrentColumn As Long)

    Dim FoundCell As Range
    Dim LastRow, i, AptNumberOffset As Long
    Dim StreetNumber As String
    Dim FirstFloorCount As Integer
    Dim SecondFloorCount As Integer
    Dim ThirdFloorCount As Integer
    Dim FirstFloor(50) As Variant
    Dim SecondFloor(50) As Variant
    Dim ThirdFloor(50) As Variant
    
    Application.ScreenUpdating = False
    
    StreetNumber = AddressAndApts.Cells(1, CurrentColumn)
    
    If StreetNumber = "Buildings Addresses" Then
    ' This option generates 5 worksheets, but should not generate one for the first column
        Exit Sub
    End If
    
    Call GetRenterData(CurrentColumn, FirstFloorCount, SecondFloorCount, ThirdFloorCount, FirstFloor, SecondFloor, ThirdFloor)
    Dim Start3rdFloor As Integer
    Start3rdFloor = FillOutputSheet(StreetNumber, FirstFloorCount, SecondFloorCount, ThirdFloorCount, FirstFloor, SecondFloor, ThirdFloor)
    Call FormatOutputSheet(StreetNumber, Start3rdFloor, ThirdFloorCount)

    Dim OutputSheet As Worksheet
    Set OutputSheet = ThisWorkbook.Sheets(StreetNumber)
    OutputSheet.PrintOut
    OutputSheet.Delete
    
    Application.ScreenUpdating = True
    
End Sub

Private Sub AddressToPrint_Click()
    
    Dim StreetAddress As String
    
    StreetAddress = AddressToPrint.List(AddressToPrint.ListIndex)
    
    PrintListsButton.Enabled = True
    SelectedPrintItem.Text = StreetAddress

End Sub

Private Sub PrintListsButton_Click()
    Dim CurrentColumn As Long
        
    If (SelectedPrintItem.Text = "All Buildings") Then
        Dim LastColumn As Long
        Dim i As Long
        LastColumn = LastColumnInRow(AddressAndApts, 1)
        LastColumn = LastColumn - 1
        For i = 1 To LastColumn
            CurrentColumn = i
            Call CreatePrintDeleteMailboxList(CurrentColumn)
        Next i
        Unload Me
    Else
        Dim FoundCell As Range
        Set FoundCell = AddressAndApts.Range("1:1").Find(What:=SelectedPrintItem.Text)
        If Not FoundCell Is Nothing Then
            CurrentColumn = FoundCell.Column
            Call CreatePrintDeleteMailboxList(CurrentColumn)
        End If
    End If
    
End Sub

Private Sub UserForm_Activate()

    Dim i As Integer
    Dim LastColumn As Long
    
    Set AddressAndApts = ThisWorkbook.Sheets("Bldgs and AppartMents")
    LastColumn = LastColumnInRow(AddressAndApts, 1)
    
    Set AddressRange = AddressAndApts.Range(AddressAndApts.Cells(1, 1), AddressAndApts.Cells(1, LastColumn))
    
    With AddressToPrint
        For i = 2 To LastColumn
            .AddItem AddressRange.Cells(1, i)
        Next i
    End With
    
    PrintListsButton.Enabled = False
    
End Sub

The Bldgs and AppartMents Data Sheet

1 Buildings Addresses    20809              20829             20909             20929             20939        All Buildings  
2                        Apartmetnts        Apartments        Apartments        Apartments        Apartments  
3                        101                117               133               149               161  
4                        102                118               134               150               162  
5                        103                119               135               151               163  
6                        104                120               136               152               164  
7                        105                121               140               153               165  
8                        106                122               141               154               166  
9                        107                123               142               155               167  
10                       108                124               143               156               168  
11                       109                125               144               157               169  
12                       110                126               145               158               170  
13                       111                127               146               159               171  
14                       112                128               147               160               172  
15                       113                129               148               249               261  
16                       114                130               233               250               262  
17                       115                131               234               251               263  
18                       116                132               235               252               264  
19                       201                217               236               253               265  
20                       202                218               241               254               266  
21                       203                219               242               255               267  
22                       204                220               243               256               268  
23                       205                221               244               257               269  
24                       206                222               245               258               270  
25                       207                223               246               259               271  
26                       208                224               247               260               272  
27                       209                225               248               350               362  
28                       210                226               338               351               363  
29                       211                227               339               352               364  
30                       212                228               340               353               365  
31                       213                229               341               356               368  
32                       214                230               344               357               369  
33                       215                231               345               358               370  
34                       216                232               346               359               371  
35                       302                322               347  
36                       303                323  
37                       304                324  
38                       305                325  
39                       308                328  
40                       309                329  
41                       310                330  
42                       311                331  

The RentRoster WorkSheet

This is a sanitized version of the Rent Roster spread sheet, the names have been altered to protect the current tenants.

Apt abc First Name  Last Name   ghi Secondary Renter
101                 
102     FName2  LastName2       
103     FName3  LastName3       
104     FName4  LastName4       
105     FName5  LastName5       
106     FName6  LastName6       
107     FName7  LastName7       
108     FName8  LastName8       XX
109     FName9  LastName9       
110     FName0  LastName0       
111     FName11 LastName11      
112     FName12 LastName12      
113     FName13 LastName13      LastName
114     FName14 LastName14      
115     FName15 LastName15      
116     FName6  LastName6       
201     FName7  LastName7       
202     FName8  LastName8       
203     FName9  LastName9       
204     FName0  LastName0       
205     FName1  LastName1       
206     FName2  LastName2       
207     FName3  LastName3       LastName16
208     FName4  LastName4       
209     FName5  LastName5       
210     FName6  LastName6       
211     LongFirstName   LongLastName        
212     AnEvenLongerFirstName   AnEvenLongerLastName        
213     FName9  LastName9       
214     FName0  LastName0       Tenant2Name
215     FName1  LastName1       
216     FName2  LongLastName2Added      Tenant2LongNameAdded
302     FName3  LastName3       
303     FName4  LastName4       
304     FName5  LastName5       XX
305     FName6  LastName6       
308                 
309     FName1  LastName1       XXXXXX
310     FName2  LastName2       
311     FName3  LastName3       
117     FName4  LastName4       
118     FName5  LastName5       XXXXX
119     FName6  LastName6       
120     FName7  LastName7       
121     FName8  LastName8       
122     FName9  LastName9       
123     FName0  LastName0       
124     FName1  LastName1       
125     FName2  LastName2       
126     FName3  LastName3       
127     FName4  LastName4       
128     FName5  LastName5       XXXXXXX
129     FName6  LastName6       
130     FName7  LastName7       XXX
131     FName8  LastName8       
132     FName9  LastName9       
217     FName0  LastName0       XXXXX
218     FName1  LastName1       
219     FName2  LastName2       
220     FName3  LastName3       
221     FName4  LastName4       
222     FName5  LastName5       
223     FName6  LastName6       
224     FName7  LastName7       
225     FName8  LastName8       
226     FName9  LastName9       
227     FName0  LastName0       
228     FName1  LastName1       XXXX
229     FName2  LastName2       
230                 
231     FName2  LastName2       
232     FName3  LastName3       
322     FName4  LastName4       XXXX
323     FName5  LastName5       
324     FName6  LastName6       
325     FName7  LastName7       XXXXX
328     FName8  LastName8       
329     FName9  LastName9       
330     FName0  LastName0       XXXXXXXX
331     FName1  LastName1       
133     FName2  LastName2       
134     FName3  LastName3       
135                 
136     FName5  LastName5       
140     FName6  LastName6       
141     FName7  LastName7       CCDDFFGG
142     FName8  LastName8       
143                 
144     FName0  LastName0       
145     FName1  LastName1       
146     FName2  LastName2       
147     FName3  LastName3       ABCDEFG
148     FName4  LastName4       
233     FName5  LastName5       
234     FName6  LastName6       
235     FName7  LastName7       
236     FName8  LastName8       XXX
241     FName9  LastName9       
242     FName0  LastName0       
243     FName1  LastName1       
244     FName2  LastName2       
245                 
246     FName4  LastName4       
247     FName5  LastName5       
248     FName6  LastName6       
338     GGGXX23B    ZYXWVUT     ABCDE
339     FName2  LastName2       
340     FName3  LastName3       
341     FName4  LastName4       
344     FName5  LastName5       
345     FName6  LastName6       
346     FName7  LastName7       
347     FName8  LastName8       
149     FName9  LastName9       
150     FName0  LastName0       
151     FName1  LastName1       
152     FName2  LastName2       
153     FName3  LastName3       
154     FName4  LastName4       
155     FName5  LastName5       
156     FName6  LastName6       
157     FName7  LastName7       
158     FName8  LastName8       
159     FName9  LastName9       
160     FName0  LastName0       
249     FName1  LastName1       
250     FName2  LastName2       
251     FName3  LastName3       
252     FName4  LastName4       
253     FName5  LastName5       
254     FName6  LastName6       
255     FName7  LastName7       
256     FName8  LastName8       
257     FName9  LastName9       
258     FName0  LastName0       
259     FName1  LastName1       
260     FName2  LastName2       
350     FName2  LastName2       XXXX
351     FName3  LastName3       
352     FName4  LastName4       XXXXXXX
353     FName5  LastName5       
356     FName8  LastName8       
357     FName9  LastName9       
358     FName0  LastName0       XXXXXXX
359     FName1  LastName1       
161     FName2  LastName2       
162     FName3  LastName3       XXXXXX
163     FName4  LastName4       
164     FName5  LastName5       
165     FName8  LastName8       
166     FName9  LastName9       
167     FName0  LastName0       XXXXX
168     FName1  LastName1       
169     FName8  LastName8       
170     FName9  LastName9       XXXXX
171     FName0  LastName0       
172                 
261     FName4  LastName4       
262     FName5  LastName5       
263     FName6  LastName6       
264     FName7  LastName7       
265     FName0  LastName0       
266     FName1  LastName1       
267     FName2  LastName2       
268     FName3  LastName3       
269     FName6  LastName6       
270     FName7  LastName7       XXX
271     FName8  LastName8       
272     FName9  LastName9       
362     FName2  LastName2       
363     FName3  LastName3       
364     FName4  LastName4       
365     FName5  LastName5       XXXXXXXX
368     FName8  LastName8       
369     FName9  LastName9       
370     FName0  LastName0       
371     FName1  LastName1       
\$\endgroup\$
9
  • 1
    \$\begingroup\$ Have you achieved your goal? Do I understand correctly that you are concerned about performance? How often are you going to run this code to worry about performance? Or is there another reason? \$\endgroup\$
    – PChemGuy
    Dec 17, 2021 at 13:32
  • 1
    \$\begingroup\$ More importantly, you say that it runs for 30s but you do not have the actual input. How can you evaluate the code then? If you do not have the real data, you need to have a mock set of matching size, shape, structure, etc. Otherwise, does it not sound like a pointless discussion? Or am I missing something? \$\endgroup\$
    – PChemGuy
    Dec 17, 2021 at 13:35
  • \$\begingroup\$ @PChemGuy I am working from the data the management office provided me. The goal is to create something that eases the work of the management office and I need to show the apartment manger what I have today. It meets the requirements of being easy to use and not requiring a lot of manual labor. I am not overly concerned with performance as much as ease of use. I will need to run this on the computer in the apartment management office to check the performance. \$\endgroup\$
    – pacmaninbw
    Dec 17, 2021 at 13:47
  • 1
    \$\begingroup\$ @pacmaninbw Do you still need some advice? \$\endgroup\$
    – AcsErno
    Jan 13 at 13:09
  • 1
    \$\begingroup\$ @AcsErno I'd like an answer because other wise this question becomes a Zombie. I got this working and then checked the version of excel on the client computer, that version is Office 2010 starter edition and doesn't support VBA. I've moved on to trying to solve this in C# with excel interop. \$\endgroup\$
    – pacmaninbw
    Jan 13 at 13:22

0

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.