Auction Application

Sometimes when I am feeling real mellow, I will write a whole application contained in a spreadsheet. This one exceeded all of my expectations. It is an elegant solution to a thorny problem.

My stamp club conducts an auction at each meeting. Before the newsletter goes out, everyone lets our auctioneer know what they have for sale and in the past he scribbled out a list and gave it to me. Anytime one writes, it will take more room than if it is typed. First we will look at code then I will have a zipped file of modules and the spreadsheet if you want to try it.

Option Explicit

Public LastRow As Integer, LastCol As Integer, RowP As Integer

Sub AddItem()
    
    Sheets("CurAuction").Select
    LastRow = Application.CountA(ActiveSheet.Range("B:B"))
    Sheets("Stuff").Activate
    LastCol = Application.CountA(ActiveSheet.Range("A:A"))
    For RowP = 1 To LastCol
        UserForm1.ComboBox1.AddItem Sheets("Stuff").Cells(RowP, 1) 'Add items to List Box
    Next RowP
    Sheets("CurAuction").Select
    UserForm1.Show
End Sub

Sub Beginn()
    Sheets("CurAuction").Select
    Range("A3").Select
End Sub

 

 Sub NewMonth()
    Dim ArchLast As Integer, PastLast, ClubIns As String
    Sheets("CurAuction").Select
    LastRow = Application.CountA(ActiveSheet.Range("A:A"))
    Range(Cells(2, 1), Cells(LastRow, 7)).Select
    Selection.Cut
    Sheets("Archive").Visible = True
    Sheets("Archive").Select
    ArchLast = Application.CountA(ActiveSheet.Range("B:B"))
    Cells(ArchLast + 1, 1).Select
    ActiveSheet.Paste
    PastLast = LastRow - 1
    Sheets("Archive").Select
    Cells(ArchLast + 1, 8) = Application.Text(Now(), "mm/dd/yyyy")
    Range(Cells(ArchLast + PastLast, 8), Cells(ArchLast + 1, 9)).Select
    Selection.FillDown
    ActiveWindow.SelectedSheets.Visible = False
    Sheets("CurAuction").Select
    Range("A2").Select
End Sub

Sub Auto_Open()
    Sheets("Front").Select
    Range("A1").Select
End Sub
 

 

02/09/2001 16:24:46

Alan's Home Falkland Islands stamps Excel & VBA