Posts by rabsofty

Storm,

on my machine it's almost instant.
can you provide me with your spreadsheet? (without sensitive data)

this is how I would do it (there are other ways to do this)

Private Sub Worksheet_Change(ByVal Target As Range)
  Application.ScreenUpdating = False
  For rw = 3 To 17
    Select Case rw
      Case 3
        r = 103: c = 8: sht = "MS01 Arrival On Site"
      Case 4
        r = 105: c = 8: sht = "MS02 Survey of Existing"
      Case 5
        r = 107: c = 8: sht = "MS03 Site Setup"
      Case 6
        r = 109: c = 8: sht = "MS04 Maintenance"
      Case 7
        r = 103: c = 11: sht = "MS05 Temporary Supplies"
      Case 8
        r = 105: c = 11: sht = "MS06 Welfare Temps"
      Case 9
        r = 107: c = 11: sht = "MS07 Isolation & Removal"
      Case 10
        r = 109: c = 11: sht = "MS08 Containment"
      Case 11
        r = 103: c = 13: sht = "MS09 Installation of Busbar"
      Case 12
        r = 105: c = 13: sht = "MS10 General Power"
      Case 13
        r = 107: c = 13: sht = "MS11 Lighting"
      Case 14
        r = 109: c = 13: sht = "MS12 Cleaners Sockets"
      Case 15
        r = 103: c = 16: sht = "MS13 Cabling & Terminations"
      Case 16
        r = 105: c = 16: sht = "MS14 Mechanical"
      Case 17
        r = 107: c = 16: sht = "MS15 Distribution"
    End Select
    Call mchg(rw, r, c, sht)
  Next rw
  Application.ScreenUpdating = True
End Sub


Private Sub mchg(rw, r, c, sht)
  tf = CBool((Cells(r, c) = "P") + 1)
  Sheets("Method Statements").Rows(rw).Hidden = tf
  Sheets(sht).Visible = Not (tf)
End Sub

yes in VBA right click on your project and select it's properties.
There you can password protect your code form being viewed

P.S.
it's not hard work, I have been doing this for a long time.

Ahh, I did not know you wanted both houses and hotels on the same property.

Done (Attached)

Note:
if house and hotel are zero, it defaults to normal rent for the property
if there houses and hotels, the 2 are added into rent

since I am not aware of all the rules to the game, perhaps you can send a short blurp.

pritt.chris,

I put your data into the spreadsheet.
I also created dice in the utility tab
the random numbers get generated every time you go into the Utility tab. (MultiPage1_Change) routine

attached is the spreadsheet

sorry about the number of houses and hotels, I just assumed you were using the normal monopoly game setup

the spread sheet is MUCH easier to do. (simply hide and protect it)

Since you are not following the normal monopoly game (Eg: you are using 10 houses and 10 hotels)
I would need you to provide me with:
rents for each property
rents for each House
rents for each Hotel
price with no houses and hotels
price per house
price per hotel
mortgage per property

I would require this to determine what kind of formula I would need.
If the rents are consistent eg: 1 house = 10 2 house = 20 3 house = 30
(the same for hotels)
then the I can use a formula to calculate it.
otherwise I would have to fill the speadsheet with all of them

If you could provide me with this info I can let you know

did you debug your program?

a copy of your spreadsheet would help (without sensitive data)

here is a new version called newmonopoly

The same thing I did for the one textbox can be done to the other three text boxes.
what are the other text boxes?

your spread sheet would be helpful.

P.S.
You forgot Tennesse in your list

if you do not want the rents in the spread sheet, you could load values into an array.

attached is a quick and dirty spreadsheet called monopoly.xlsm.

your wlecome

please provide your spreadsheet (without sensitive information.

another way to format it is wrap TEXT command around formula with the format you want

=TEXT(IF(OR(WEEKDAY(A1)=1,WEEKDAY(A1)=7),A1+2,IF(WEEKDAY(A1)=2,A1+1,A1)),"dddd dd mmm, yyyy")

oops forgot - the cell you put the formula into format it with (dddd dd mmm, yyyy) to get the output you want

Here you go.
Note: date in A1 Eg: 2019/12/26

=IF(OR(WEEKDAY(A1)=1,WEEKDAY(A1)=7),A1+2,IF(WEEKDAY(A1)=2,A1+1,A1))

when you add an item, you must access it by it's listindex
when you add an item to the end of a list, you can use listcount - 1 to get the item just added

there are other ways to do this, (you could filter your spreadsheet by your month and null then range add it to your listbox as well.)

also, I made an error in testing, you had "December" for the month, but I put december in spread sheet and it did not find it.
(I forgot about case sensitivity)
if you want to avoid case sensitivity, in your if statement you could add
If LCase(ws1.(Cells(k, 8))) = mnth And ws1.Cells(k, 7) <> vbNullString Then

and change mnth from December to december

Dim ws1 As Worksheet
Dim k As Integer
Dim lstrow As Long


Set ws1 = ThisWorkbook.Sheets("Expenses")
lstrow = ws1.Cells(ws1.Rows.Count, 8).End(xlUp).Row
mnth = "December"


    ListBox1.Clear
    ListBox1.ColumnCount = 7
   
    For k = 2 To lstrow
      If ws1.Cells(k, 8).Value = mnth And ws1.Cells(k, 7).Value <> vbNullString Then
        ListBox1.AddItem ws1.Cells(k, 2).Value 'Sheets("expenses").Range("B" & k, "H" & k).Value
        li = ListBox1.ListCount - 1 'get listindex of item just added
        ListBox1.List(li, 1) = ws1.Cells(k, 3)
        ListBox1.List(li, 2) = ws1.Cells(k, 4)
        ListBox1.List(li, 3) = ws1.Cells(k, 5)
        ListBox1.List(li, 4) = ws1.Cells(k, 6)
        ListBox1.List(li, 5) = ws1.Cells(k, 7)
        ListBox1.List(li, 6) = ws1.Cells(k, 8)
      End If
    Next k

I'm using excel 2010, in my version in the File,options, menu, general settings section I changed the font setting there.
when I create a sheet, it default to what was set there

attach your spreadsheet (leave out any sensitive data)