Is it possible to make a button that changes the formula?

Want2BExcel

Board Regular
Joined
Nov 24, 2021
Messages
112
Office Version
  1. 2016
Platform
  1. Windows
Is it possible to make a button that changes the formula?

Right now the formula is "pointing" to the expected.expenses. but when a month is over I import all the actual expenses in a new sheet. Now I, of course, know what I have to do to change the formula to point to the new sheet. But if I gave this budget to friends, they don't know what to do. So if there was a button, they just could click on and then a drop-down menu opens to choose witch month he/she would like to apply the "new" formula...voila :)

So from this:
Original in danish: =SUM.HVIS(ANSLÅET.UDGIFTER[Tekst];[@[Postering tekst]];ANSLÅET.UDGIFTER[Januar])
In english: =SUMIF(EXPECTED.EXPENSES[Text];[@[Postering text]];EXPECTED.EXPENSES[January])

The user pushes the button and a dropdown menu opens with all 12 months to choose from. Pick January and the formulas in all rows in that whole column (January) changes to...

To this:
Original in danish: =SUM.HVIS(BUDGET_JAN_22[Tekst];[@[Postering tekst]];BUDGET_JAN_22[Beløb])
In english: =SUMIF(BUDGET_JAN_22[Text];[@[Postering text]];BUDGET_JAN_22[Amount])

It would be amazing!
 
What do you have to do ?
* check how may listobjects you have in "BudgetKonto 22", hopefully 1, if not the table you want to change, is that the listobject with indexnumber 1 ? If you run the macro, at the end, before changing the formula, you get a msgbox with the range concerned. Is that within your table, then it's okay, otherwise escape with CTRL+BREAK and then "STOP".
* the listobject in your new table "jan '22" is cell A1 part of that listobject ?
You hope it works without questions from your side ...:unsure:
 
Upvote 0

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.
What do you have to do ?
* check how may listobjects you have in "BudgetKonto 22", hopefully 1, if not the table you want to change, is that the listobject with indexnumber 1 ? If you run the macro, at the end, before changing the formula, you get a msgbox with the range concerned. Is that within your table, then it's okay, otherwise escape with CTRL+BREAK and then "STOP".
* the listobject in your new table "jan '22" is cell A1 part of that listobject ?
You hope it works without questions from your side ...:unsure:
I can see that it works on your workbook, but when I try to run it on mine, then it starts ok, but can't find January in the end.:unsure: I'm still impressed by your work though!!!
 

Attachments

  • Udklip_1.JPG
    Udklip_1.JPG
    16.2 KB · Views: 4
  • Udklip_2.JPG
    Udklip_2.JPG
    20.1 KB · Views: 4
Upvote 0
with this macro, you check in sheet "BudgetKonto 22" the first listobject (historical first), its name, its address and the names above in the headerrow.
Or you are in the wrong listobject or there is no "Januar" in the headerrow.
Alternatives if the listobject is wrong
- increment the number = With Sheets("BudgetKonto 22").ListObjects(2)
- find the name of that listobject = With Sheets("BudgetKonto 22").ListObjects("MyName")
- find a cell in that listobject = With Sheets("BudgetKonto 22").range("D25").ListObject
and later in the original macro
for example
Set cMyKol = Sheets("BudgetKonto 22").ListObjects("MyName").ListColumns(smonth).DataBodyRange
VBA Code:
Sub test()
     With Sheets("BudgetKonto 22").ListObjects(1)
          MsgBox .Name & vbLf & .Range.Address, , UCase("name and address listobject 1")
          a = Application.Transpose(Application.Transpose(.HeaderRowRange.Value))
          MsgBox Join(a, vbLf), , UCase("headernames")
     End With
End Sub
 
Upvote 0
with this macro, you check in sheet "BudgetKonto 22" the first listobject (historical first), its name, its address and the names above in the headerrow.
Or you are in the wrong listobject or there is no "Januar" in the headerrow.
Alternatives if the listobject is wrong
- increment the number = With Sheets("BudgetKonto 22").ListObjects(2)
- find the name of that listobject = With Sheets("BudgetKonto 22").ListObjects("MyName")
- find a cell in that listobject = With Sheets("BudgetKonto 22").range("D25").ListObject
and later in the original macro
for example
Set cMyKol = Sheets("BudgetKonto 22").ListObjects("MyName").ListColumns(smonth).DataBodyRange
VBA Code:
Sub test()
     With Sheets("BudgetKonto 22").ListObjects(1)
          MsgBox .Name & vbLf & .Range.Address, , UCase("name and address listobject 1")
          a = Application.Transpose(Application.Transpose(.HeaderRowRange.Value))
          MsgBox Join(a, vbLf), , UCase("headernames")
     End With
End Sub
I have tried running the test and I get these...

But according to the 2nd pic, there is a headerrow called "januar", but I keep getting the same error as in described in #12

...I just don't understand, sorry!
Test1.JPG
Test2.JPG
 
Upvote 0
with this macro, you check in sheet "BudgetKonto 22" the first listobject (historical first), its name, its address and the names above in the headerrow.
Or you are in the wrong listobject or there is no "Januar" in the headerrow.
Alternatives if the listobject is wrong
- increment the number = With Sheets("BudgetKonto 22").ListObjects(2)
- find the name of that listobject = With Sheets("BudgetKonto 22").ListObjects("MyName")
- find a cell in that listobject = With Sheets("BudgetKonto 22").range("D25").ListObject
and later in the original macro
for example
Set cMyKol = Sheets("BudgetKonto 22").ListObjects("MyName").ListColumns(smonth).DataBodyRange
VBA Code:
Sub test()
     With Sheets("BudgetKonto 22").ListObjects(1)
          MsgBox .Name & vbLf & .Range.Address, , UCase("name and address listobject 1")
          a = Application.Transpose(Application.Transpose(.HeaderRowRange.Value))
          MsgBox Join(a, vbLf), , UCase("headernames")
     End With
End Sub
I think I found the error :) It said "BudgetKonto 22" and I changed it to "BudgetKonto 2022" and now it works ;)

NOW....can I use this to make a button that runs the macro?

1643761357741.png
 
Upvote 0
I don't know if this apply as a new question.

If I want to make a button that do the reverse thing

I tried myself, but I couldn't, because I just don't understand this quite yet. In this case the formula should change from BUDGET_JAN_22[Amount] to EXPECTED.EXPENSES[January]
keep in mind that BUDGET_JAN_22 could be BUDGET_FEB_22 or in a year or two BUDGET_DEC_24

So from this:
Original in danish: =SUM.HVIS(BUDGET_JAN_22[Tekst];[@[Postering tekst]];BUDGET_JAN_22[Beløb])
In english: =SUMIF(BUDGET_JAN_22[Text];[@[Postering text]];BUDGET_JAN_22[Amount])

The user pushes the button and a dropdown menu opens with all 12 months to choose from. Pick January and the formulas in all rows in that whole column (January) changes to...

To this:
Original in danish: =SUM.HVIS(ANSLÅET.UDGIFTER[Tekst];[@[Postering tekst]];ANSLÅET.UDGIFTER[Januar])
In english: =SUMIF(EXPECTED.EXPENSES[Text];[@[Postering text]];EXPECTED.EXPENSES[January])

...the point of this is to make it easier to make a new sheet for next year etc. and therefor it is nessersary to make it point to ANSLÅET.UDGIFTER (in english: XPECTED.EXPENSES) sheet again

or is there a entirely better way to make a new sheet for next year including the button with the macro, rename it and make it point to ANSLÅET.UDGIFTER (in english: XPECTED.EXPENSES)
 
Upvote 0
with your screenshots (except, the sheetname is "Anslåede.udgifter_" to make a difference with the table "Anslåede.udgifter", otherwise VBA gives an error)
VBA Code:
Sub NewMonth()
     Dim Answ, FL, ShName, sMon, cMyKol As Range, LO_Month As ListObject

     a = [transpose(row(A1:A12) &". " & text(row(A1:A12)*28,"[$-0406]mmmm"))]     'danish monthnames + index
     Answ1 = Application.InputBox("0. Stop, nothing to change" & vbLf & vbLf & Join(a, vbLf), UCase("What month do you want to change"), 0, 100, 100, , , 1)
     If Answ1 = 0 Then Exit Sub                                 '=stop

     Select Case Answ1
          Case 1 To 12
               smonth = Split(a(Answ1))(1)
               sMon = Left(smonth, 3)               'first 3 letters of choosen month
               For i = 1 To Worksheets.Count
                    If StrComp(Left(Worksheets(i).Name, 3), sMon, vbTextCompare) = 0 Then s = s & vbLf & i & ". " & Worksheets(i).Name     'string with all sheets starting with sMon
               Next
               If Len(s) = 0 Then MsgBox "no sheets starting with " & sMon & " found" & vbLf & "sorry", vbInformation: Exit Sub     'no sheets found = end of story
               Answ = Application.InputBox("0. Stop, nothing to change" & vbLf & vbLf & s, UCase("What sheet number do you want ?"), 0, 100, 100, , , 1)     'choice between 1 or several options
               If Answ = 0 Then Exit Sub                        '0=stop
               FL = Filter(Split(Mid(s, 2), vbLf), Answ & ". ", 1, vbTextCompare)     'filter selection of sheets with your answer; normally 1 option left
               If UBound(FL) <> 0 Then MsgBox "fatal error": Exit Sub     'normally only 1 sheet left, so why ???
               ShName = Trim(Mid(Replace(FL(0), " ", WorksheetFunction.Rept(" ", 100), 1, 1, vbTextCompare), 100))     'get rid of the indexnumber
               On Error Resume Next
               Set LO_Month = Sheets(ShName).Range("A1").ListObject     ' the wanted listobjects contains cell A1 of that sheet
               If LO_Month Is Nothing Then MsgBox "no listobject in A1 of " & ShName, vbCritical: Exit Sub     'listobject of that month not found

               Set cMyKol = Sheets("BudgetKonto 22").ListObjects(1).ListColumns(smonth).DataBodyRange
               If cMyKol Is Nothing Then MsgBox "your month " & smonth & " not found", vbCritical: Exit Sub
               On Error GoTo 0
           
               MsgBox cMyKol.Address
               cMyKol.FormulaR1C1 = "=SUMIF(" & LO_Month.Name & "[Tekst],[@[Postering tekst]], " & LO_Month.Name & "[Beløb])"

          Case Else: MsgBox "only 12 months in a year", vbInformation
     End Select

End Sub
Want2BeExcel.xlsm
ABCDEF
1BeskrivelseBetaling metodePostering tekstJanuarFebruarMarts
2Bolig 
3HuslejeBetalings ServiceUDLEJER-2.000,00 -5.700,00
4AffaldBetalings ServiceKOMMUNE-500,00-4.500,00 
5   
6
BudgetKonto 22
Cell Formulas
RangeFormula
D2:D5D2=SUMIF(Tabel3[Tekst],[@[Postering tekst]], Tabel3[Beløb])
E3:E5E3=SUMIF(ANSLÅET.UDGIFTER[Tekst],[@[Postering tekst]],ANSLÅET.UDGIFTER[Februar])
F3:F5F3=SUMIF(ANSLÅET.UDGIFTER[Tekst],[@[Postering tekst]],ANSLÅET.UDGIFTER[Marts])


Want2BeExcel.xlsm
I just noticed that the code changes ALL the cells in the table. Both empty cells (spaces) and SUM cells...!? Can I change something in the code, so it only targets the cells that have the previous formula in them?
 
Upvote 0
I just noticed that the code changes ALL the cells in the table. Both empty cells (spaces) and SUM cells...!? Can I change something in the code, so it only targets the cells that have the previous formula in them?
Here you can see the difference. Look at cells D85,D103,D106 and D107 (It's total sum cells, and shouldn't change) futhermore cells D5,10,16,36,43,49,52,57,61,68,84,87,102,104,105,108 and 109 should be empty. Any of these rows numbers can vary depending on how many rows you use, but any cell that have a different formula or is empty should not be affected.

2022 - PrivatBudget ver.2.2.02 - SKABELON_macro - Kopi.xlsm
ABCDEF
1
2
3
4BeskrivelseBetaling metodePostering tekstJanuarFebruarMarts
5Bolig 
6HuslejeBetalings ServiceUDLEJER-4.500,00-4.500,00-4.500,00
7AffaldBetalings ServiceKOMMUNE--700,00-
8---
10Forbrug 
11VandBetalings ServiceBS VAND FORSYNING-390,00-390,00-390,00
12FjernvarmeBetalings ServiceBS FJERNVARMEVÆRK-319,00-319,00-319,00
13ELAut. Kortbetaling*EL FORSYNING-2.284,00-2.284,00-2.284,00
14---
16Forsikringer 
17Indbo-, BilForsikringBetalings ServiceBS FORSIKRING-8.700,00--
18SygesikringBetalings ServiceBS SYGEFORSIKRING-700,00-700,00-700,00
19---
22Multimedia 
23InternetAut. Kortbetaling*FASTSPEED-200,00-200,00-200,00
24TelefonAut. Kortbetaling*MOBIL-150,00-150,00-150,00
25TVForretning: PAYPAL *YOUSEE-450,00-450,00-450,00
26---
36Transport 
37VægtafgiftBetalings ServiceBS GRØN AFGIFT-1.050,00--
38BenzinBenzinkort-900,00-900,00-900,00
39BillånBetalings ServiceToyota-1.450,00-1.450,00-1.450,00
40---
43Øvrige Faste 
46---
49Kost 
50Kost78960001234567-9,99-9,99-9,99
51---
52Renter & Gebyrer 
53Ovf. RenteOvf. Rente*-9,00--
54RenteRente*-389,00--
55GebyrGebyr*---
56---
57Opsparing 
58---
61Overførsel til resterende konti 
62---
68Diverse ekstra udgifter (ej faste) 
69Tandlæge*TANDLÆGE*-99,00-99,00-99,00
70TøjTøj-500,00-500,00-500,00
71---
84Udgifter Totalt 
85Udgifter indeværende måned i alt-22.099,99-12.651,99-11.951,99
86  
87Indtægt (BEMÆRK!!! Løn går ind SIDST i måneden, er budgetteret i den samme måned. Derfor HUSK at budgetkonto saldo ikke er retvisende FØR udløb af måneden) 
88LønARBEJDE25.000,0025.000,0025.000,00
89---
102Indtægter Totalt 
103Udgifter indeværende måned i alt25.000,0025.000,0025.000,00
104 
105Beregninger 
106Overskud/underskud indeværende måned2.900,0112.348,0113.048,01
107Mindste saldo på konto2.900,01kr. 15.248,02kr. 28.296,03
Budgetkonto 2022
Cell Formulas
RangeFormula
D88:D89,D69:D71,D62,D58,D53:D56,D50:D51,D46,D37:D40,D23:D26,D17:D19,D11:D14,D6:D8D6=SUMIF(ANSLÅET.UDGIFTER[Tekst],[@[Postering tekst]],ANSLÅET.UDGIFTER[Januar])
E88:E89,E86,E69:E71,E62,E58,E53:E56,E50:E51,E46,E37:E40,E23:E26,E17:E19,E11:E14,E6:E8E6=SUMIF(ANSLÅET.UDGIFTER[Tekst],[@[Postering tekst]],ANSLÅET.UDGIFTER[Februar])
D85:F85D85=SUM(D6:D83)
D103:F103D103=SUM(D88:D101)
F104:F105,F102,F86:F89,F84,F68:F71,F61:F62,F49:F58,F46,F43,F36:F40,F22:F26,F16:F19,F10:F14,F5:F8F5=SUMIF(ANSLÅET.UDGIFTER[Tekst],[@[Postering tekst]],ANSLÅET.UDGIFTER[Marts])
D106:F106D106=SUM(D103)+D85
D107D107=SUM(D106)
E107:F107E107=SUM(E106+D107)


2022 - PrivatBudget ver.2.2.02 - SKABELON_macro - Kopi.xlsm
ABCDEF
1
2
3
4BeskrivelseBetaling metodePostering tekstJanuarFebruarMarts
5Bolig  
6HuslejeBetalings ServiceUDLEJER-2.000,00-4.500,00-4.500,00
7AffaldBetalings ServiceKOMMUNE--700,00-
8---
10Forbrug  
11VandBetalings ServiceBS VAND FORSYNING-2.500,00-390,00-390,00
12FjernvarmeBetalings ServiceBS FJERNVARMEVÆRK-2.284,00-319,00-319,00
13ELAut. Kortbetaling*EL FORSYNING-319,00-2.284,00-2.284,00
14---
16Forsikringer  
17Indbo-, BilForsikringBetalings ServiceBS FORSIKRING---
18SygesikringBetalings ServiceBS SYGEFORSIKRING--700,00-700,00
19---
22Multimedia  
23InternetAut. Kortbetaling*FASTSPEED-434,00-200,00-200,00
24TelefonAut. Kortbetaling*MOBIL-98,00-150,00-150,00
25TVForretning: PAYPAL *YOUSEE-102,70-450,00-450,00
26---
36Transport  
37VægtafgiftBetalings ServiceBS GRØN AFGIFT-1.490,00--
38BenzinBenzinkort-379,00-900,00-900,00
39BillånBetalings ServiceToyota-537,50-1.450,00-1.450,00
40---
43Øvrige Faste  
46---
49Kost  
50Kost78960001234567-36,00-9,99-9,99
51---
52Renter & Gebyrer  
53Ovf. RenteOvf. Rente*-134,92--
54RenteRente*-429,00--
55GebyrGebyr*-353,72--
56---
57Opsparing  
58---
61Overførsel til resterende konti  
62---
68Diverse ekstra udgifter (ej faste)  
69Tandlæge*TANDLÆGE*-389,00-99,00-99,00
70TøjTøj-54,25-500,00-500,00
71---
84Udgifter Totalt  
85Udgifter indeværende måned i alt--12.651,99-11.951,99
86   
87Indtægt (BEMÆRK!!! Løn går ind SIDST i måneden, er budgetteret i den samme måned. Derfor HUSK at budgetkonto saldo ikke er retvisende FØR udløb af måneden)  
88LønARBEJDE26.000,0025.000,0025.000,00
89---
102Indtægter Totalt  
103Udgifter indeværende måned i alt-25.000,0025.000,00
104  
105Beregninger  
106Overskud/underskud indeværende måned-12.348,0113.048,01
107Mindste saldo på konto-kr. 12.348,01kr. 25.396,02
Budgetkonto 2022
Cell Formulas
RangeFormula
E88:E89,E86,E69:E71,E62,E58,E53:E56,E50:E51,E46,E37:E40,E23:E26,E17:E19,E11:E14,E6:E8E6=SUMIF(ANSLÅET.UDGIFTER[Tekst],[@[Postering tekst]],ANSLÅET.UDGIFTER[Februar])
E85:F85E85=SUM(E6:E83)
E103:F103E103=SUM(E88:E101)
D102:D107,D84:D89,D68:D71,D61:D62,D49:D58,D46,D43,D36:D40,D22:D26,D16:D19,D10:D14,D5:D8D5=SUMIF(BUDGET_JAN_22[Tekst],[@[Postering tekst]], BUDGET_JAN_22[Beløb])
F104:F105,F102,F86:F89,F84,F68:F71,F61:F62,F49:F58,F46,F43,F36:F40,F22:F26,F16:F19,F10:F14,F5:F8F5=SUMIF(ANSLÅET.UDGIFTER[Tekst],[@[Postering tekst]],ANSLÅET.UDGIFTER[Marts])
E106:F106E106=SUM(E103)+E85
E107:F107E107=SUM(E106+D107)
 
Upvote 0
with your screenshots (except, the sheetname is "Anslåede.udgifter_" to make a difference with the table "Anslåede.udgifter", otherwise VBA gives an error)
VBA Code:
Sub NewMonth()
     Dim Answ, FL, ShName, sMon, cMyKol As Range, LO_Month As ListObject

     a = [transpose(row(A1:A12) &". " & text(row(A1:A12)*28,"[$-0406]mmmm"))]     'danish monthnames + index
     Answ1 = Application.InputBox("0. Stop, nothing to change" & vbLf & vbLf & Join(a, vbLf), UCase("What month do you want to change"), 0, 100, 100, , , 1)
     If Answ1 = 0 Then Exit Sub                                 '=stop

     Select Case Answ1
          Case 1 To 12
               smonth = Split(a(Answ1))(1)
               sMon = Left(smonth, 3)               'first 3 letters of choosen month
               For i = 1 To Worksheets.Count
                    If StrComp(Left(Worksheets(i).Name, 3), sMon, vbTextCompare) = 0 Then s = s & vbLf & i & ". " & Worksheets(i).Name     'string with all sheets starting with sMon
               Next
               If Len(s) = 0 Then MsgBox "no sheets starting with " & sMon & " found" & vbLf & "sorry", vbInformation: Exit Sub     'no sheets found = end of story
               Answ = Application.InputBox("0. Stop, nothing to change" & vbLf & vbLf & s, UCase("What sheet number do you want ?"), 0, 100, 100, , , 1)     'choice between 1 or several options
               If Answ = 0 Then Exit Sub                        '0=stop
               FL = Filter(Split(Mid(s, 2), vbLf), Answ & ". ", 1, vbTextCompare)     'filter selection of sheets with your answer; normally 1 option left
               If UBound(FL) <> 0 Then MsgBox "fatal error": Exit Sub     'normally only 1 sheet left, so why ???
               ShName = Trim(Mid(Replace(FL(0), " ", WorksheetFunction.Rept(" ", 100), 1, 1, vbTextCompare), 100))     'get rid of the indexnumber
               On Error Resume Next
               Set LO_Month = Sheets(ShName).Range("A1").ListObject     ' the wanted listobjects contains cell A1 of that sheet
               If LO_Month Is Nothing Then MsgBox "no listobject in A1 of " & ShName, vbCritical: Exit Sub     'listobject of that month not found

               Set cMyKol = Sheets("BudgetKonto 22").ListObjects(1).ListColumns(smonth).DataBodyRange
               If cMyKol Is Nothing Then MsgBox "your month " & smonth & " not found", vbCritical: Exit Sub
               On Error GoTo 0
           
               MsgBox cMyKol.Address
               cMyKol.FormulaR1C1 = "=SUMIF(" & LO_Month.Name & "[Tekst],[@[Postering tekst]], " & LO_Month.Name & "[Beløb])"

          Case Else: MsgBox "only 12 months in a year", vbInformation
     End Select

End Sub
Want2BeExcel.xlsm
ABCDEF
1BeskrivelseBetaling metodePostering tekstJanuarFebruarMarts
2Bolig 
3HuslejeBetalings ServiceUDLEJER-2.000,00 -5.700,00
4AffaldBetalings ServiceKOMMUNE-500,00-4.500,00 
5   
6
BudgetKonto 22
Cell Formulas
RangeFormula
D2:D5D2=SUMIF(Tabel3[Tekst],[@[Postering tekst]], Tabel3[Beløb])
E3:E5E3=SUMIF(ANSLÅET.UDGIFTER[Tekst],[@[Postering tekst]],ANSLÅET.UDGIFTER[Februar])
F3:F5F3=SUMIF(ANSLÅET.UDGIFTER[Tekst],[@[Postering tekst]],ANSLÅET.UDGIFTER[Marts])


Want2BeExcel.xlsm
I added a "few lines" ? to clear up the issues I discovered. Maybe it can be done more efficient, but it works ?

Thank you so much BSALV!!!! ?

VBA Code:
Sub IndsætFaktiskeUdgifter()
     Dim Answ, FL, ShName, sMon, cMyKol As Range, LO_Month As ListObject

     a = [transpose(row(A1:A12) &". " & text(row(A1:A12)*28,"[$-0406]mmmm"))]     'danish monthnames + index
     Answ1 = Application.InputBox("0. Stop, intet at ændre" & vbLf & vbLf & Join(a, vbLf), UCase("Hvilken måned vil du ændre"), 0, 100, 100, , , 1)
     If Answ1 = 0 Then Exit Sub                                 '=stop

     Select Case Answ1
          Case 1 To 12
               smonth = Split(a(Answ1))(1)
               sMon = Left(smonth, 3)               'first 3 letters of choosen month
               For i = 1 To Worksheets.Count
                    If StrComp(Left(Worksheets(i).Name, 3), sMon, vbTextCompare) = 0 Then s = s & vbLf & i & ". " & Worksheets(i).Name     'string with all sheets starting with sMon
               Next
               If Len(s) = 0 Then MsgBox "Ingen ark der begynder med " & sMon & " found" & vbLf & "Undskyld", vbInformation: Exit Sub     'no sheets found = end of story
               Answ = Application.InputBox("0. Stop, intet at ændre" & vbLf & vbLf & s, UCase("Hvilket ark vil du bruge ?"), 0, 100, 100, , , 1)     'choice between 1 or several options
               If Answ = 0 Then Exit Sub                        '0=stop
               FL = Filter(Split(Mid(s, 2), vbLf), Answ & ". ", 1, vbTextCompare)     'filter selection of sheets with your answer; normally 1 option left
               If UBound(FL) <> 0 Then MsgBox "Alvorlig fejl": Exit Sub     'normally only 1 sheet left, so why ???
               ShName = Trim(Mid(Replace(FL(0), " ", WorksheetFunction.Rept(" ", 100), 1, 1, vbTextCompare), 100))     'get rid of the indexnumber
               On Error Resume Next
               Set LO_Month = Sheets(ShName).Range("A1").ListObject     ' the wanted listobjects contains cell A1 of that sheet
               If LO_Month Is Nothing Then MsgBox "no listobject in A1 of " & ShName, vbCritical: Exit Sub     'listobject of that month not found

               Set cMyKol = Sheets("BudgetKonto 2022").ListObjects(1).ListColumns(smonth).DataBodyRange
               If cMyKol Is Nothing Then MsgBox "your month " & smonth & " not found", vbCritical: Exit Sub
               On Error GoTo 0
            
               MsgBox cMyKol.Address
               cMyKol.FormulaR1C1 = "=SUMIF(" & LO_Month.Name & "[Tekst],[@[Postering tekst]], " & LO_Month.Name & "[Beløb])"

          Case Else: MsgBox "Kun 12 måneder på et år", vbInformation
     End Select

    Range("D5:P5").Select
    Selection.ClearContents
    Range("D10:P10").Select
    Selection.ClearContents
    Range("D16:P16").Select
    Selection.ClearContents
    Range("D22:P22").Select
    Selection.ClearContents
    Range("D36:P36").Select
    Selection.ClearContents
    Range("D43:P43").Select
    Selection.ClearContents
    Range("D49:P49").Select
    Selection.ClearContents
    Range("D52:P52").Select
    Selection.ClearContents
    Range("D57:P57").Select
    Selection.ClearContents
    Range("D61:P61").Select
    Selection.ClearContents
    Range("D68:P68").Select
    Selection.ClearContents
    Range("D84:P84").Select
    Selection.ClearContents
    Range("D86:P86").Select
    Selection.ClearContents
    Range("D87:P87").Select
    Selection.ClearContents
    Range("D102:P102").Select
    Selection.ClearContents
    Range("D104:P104").Select
    Selection.ClearContents
    Range("D105:P105").Select
    Selection.ClearContents
    Range("D108:P108").Select
    Selection.ClearContents
    Range("D109:P109").Select
    Selection.ClearContents
    
    Range("D85").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-79]C:R[-10]C)"
    Range("E85").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-79]C:R[-10]C)"
    Range("F85").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-79]C:R[-10]C)"
    Range("G85").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-79]C:R[-10]C)"
    Range("H85").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-79]C:R[-10]C)"
    Range("I85").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-79]C:R[-10]C)"
    Range("J85").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-79]C:R[-10]C)"
    Range("K85").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-79]C:R[-10]C)"
    Range("L85").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-79]C:R[-10]C)"
    Range("M85").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-79]C:R[-10]C)"
    Range("N85").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-79]C:R[-10]C)"
    Range("O85").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-79]C:R[-10]C)"
    Range("P85").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-79]C:R[-10]C)"
    
    Range("D103").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-15]C:R[-2]C)"
    Range("E103").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-15]C:R[-2]C)"
    Range("F103").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-15]C:R[-2]C)"
    Range("G103").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-15]C:R[-2]C)"
    Range("H103").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-15]C:R[-2]C)"
    Range("I103").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-15]C:R[-2]C)"
    Range("J103").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-15]C:R[-2]C)"
    Range("K103").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-15]C:R[-2]C)"
    Range("L103").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-15]C:R[-2]C)"
    Range("M103").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-15]C:R[-2]C)"
    Range("N103").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-15]C:R[-2]C)"
    Range("O103").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-15]C:R[-2]C)"
    Range("P103").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-15]C:R[-2]C)"
        
    Range("D106").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-3]C+R[-21]C)"
    Range("E106").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-3]C+R[-21]C)"
    Range("F106").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-3]C+R[-21]C)"
    Range("G106").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-3]C+R[-21]C)"
    Range("H106").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-3]C+R[-21]C)"
    Range("I106").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-3]C+R[-21]C)"
    Range("J106").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-3]C+R[-21]C)"
    Range("K106").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-3]C+R[-21]C)"
    Range("L106").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-3]C+R[-21]C)"
    Range("M106").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-3]C+R[-21]C)"
    Range("N106").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-3]C+R[-21]C)"
    Range("O106").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-3]C+R[-21]C)"
    Range("P106").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-3]C+R[-21]C)"
    
    Range("D107").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-1]C+'Budgetkonto 2021'!R[-14]C[10])"
    Range("E107").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-1]C+[@Januar])"
    Range("F107").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-1]C+[@Februar])"
    Range("G107").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-1]C+[@Marts])"
    Range("H107").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-1]C+[@April])"
    Range("I107").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-1]C+[@Maj])"
    Range("J107").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-1]C+[@Juni])"
    Range("K107").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-1]C+[@Juli])"
    Range("L107").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-1]C+[@August])"
    Range("M107").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-1]C+[@September])"
    Range("N107").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-1]C+[@Oktober])"
    Range("O107").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-1]C+[@November])"
    Range("D6").Select
    
End Sub
 
Upvote 0

Forum statistics

Threads
1,215,032
Messages
6,122,770
Members
449,095
Latest member
m_smith_solihull

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top