Forum Discussion
puzzeled
Hi all!!
I have a database that I have been using and updating for a while now and started having issues after adding another column of information to the database but can't figure out whats going on! I would attach a test copy of it for your use but there is no upload option! Let me know what you need!
I enter the information in the form, hit the close button which normally saves the data from A2:H2 and sorts it in descending order by date. I have started trying to keep track of profits/losses in the "I" column and have it do the same thing only from A2:I2 and it pops up with "Run-time error '1004' To do this, all merged cells need to be the same size" but I have nothing merged and fonts are all the same size!
Just a bit confused! Any ideas?
tried to attach file, which is an .xlsm file so it wouldn't accept it. Here is the code involved and the line that is causing the error. BTW, there are no merges in the range. However, if the "I2" is blank to begin with, it works! It seems like maybe it doesn't like that field filled when entering new info. It won't sort it.
Public lngR As LongPrivate Sub Form_Load() Me.[frmEntryForm].SetFocus DoCmd.GoToRecord , , acLast End Sub Private Sub Clear_Click() Dim ctl For Each ctl In Me.Controls If TypeOf ctl Is msforms.TextBox Then ctl.Text = "" End If Next ctl DateBox.SetFocus 'Sheets("Data").Range("B4") = 1 End Sub Private Sub CloseAndSave_Click() Dim NR As Long, Ctrl As Control Stop Application.EnableEvents = False With Sheets("Sheet1") NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1 .Range("A" & NR).Value = DateBox.Text .Range("B" & NR).Value = Ball1.Text .Range("C" & NR).Value = Ball2.Text .Range("D" & NR).Value = Ball3.Text .Range("E" & NR).Value = Ball4.Text .Range("F" & NR).Value = Ball5.Text .Range("G" & NR).Value = Power.Text .Range("H" & NR).Value = PowerPlay.Text '.Range("I" & NR).Value = Winnings.Text .Range("A1:I" & NR).CurrentRegion.Sort .Range("A1"), xlDescending, Header:=xlYes, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom End With Application.EnableEvents = True Application.EnableEvents = False Dim cell As Range Dim mycount As Long Dim mycounta As Long Dim mycountb As Long Dim mycountc As Long Dim mycountd As Long Dim mycountplus As Long Dim mycountaplus As Long Dim mycountbplus As Long Dim mycountcplus As Long Dim mycountdplus As Long Dim Totalwon As Long Dim won As Long Dim wona As Long Dim wonb As Long Dim wonc As Long Dim wond As Long 'Stop For Each cell In Range("M12:Q12") If cell.DisplayFormat.Interior.Color = 12611584 Then mycount = mycount + 1 Next cell If Range("R12").DisplayFormat.Interior.Color = 12611584 Then mycountplus = 4 For Each cell In Range("M13:Q13") If cell.DisplayFormat.Interior.Color = 12611584 Then mycounta = mycounta + 1 Next cell If Range("R13").DisplayFormat.Interior.Color = 12611584 Then mycountaplus = 4 For Each cell In Range("M14:Q14") If cell.DisplayFormat.Interior.Color = 12611584 Then mycountb = mycountb + 1 Next cell If Range("R14").DisplayFormat.Interior.Color = 12611584 Then mycountbplus = 4 For Each cell In Range("M15:Q15") If cell.DisplayFormat.Interior.Color = 12611584 Then mycountc = mycountc + 1 Next cell If Range("R15").DisplayFormat.Interior.Color = 12611584 Then mycountcplus = 4 For Each cell In Range("M16:Q16") If cell.DisplayFormat.Interior.Color = 12611584 Then mycountd = mycountd + 1 Next cell If Range("R16").DisplayFormat.Interior.Color = 12611584 Then mycountdplus = 4 Totalwon = 0 Select Case mycount Case 0 If mycount = 0 And mycountplus Then won = 4 + Totalwon Else won = 0 End If Case 1 If mycount = 1 And mycountplus Then won = 4 + Totalwon Else won = 0 End If Case 2 If mycount = 2 And mycountplus Then won = 7 + Totalwon Else won = 0 End If Case 3 If mycount = 3 And mycountplus Then won = 100 + Totalwon Else won = 7 + Totalwon End If Case 4 If mycount = 4 And mycountplus Then won = 50000 + Totalwon Else won = 100 + Totalwon End If Case 5 If mycount = 5 And mycountplus Then Totalwon = won + wona + wonb + wonc + wond MsgBox ("JACKPOT!!! Plus $ " & Totalwon) GoTo Makeitzero Else won = 1000000 + Totalwon End If End Select Select Case mycounta Case 0 If mycounta = 0 And mycountplus Then wona = 4 + Totalwon Else wona = 0 End If Case 1 If mycounta = 1 And mycountaplus Then wona = 4 + Totalwon Else wona = 0 End If Case 2 If mycounta = 2 And mycountaplus Then wona = 7 + Totalwon Else wona = 0 End If Case 3 If mycounta = 3 And mycountaplus Then wona = 100 + Totalwon Else wona = 7 + Totalwon End If Case 4 If mycounta = 4 And mycountaplus Then wona = 50000 + Totalwon Else wona = 100 + Totalwon End If Case 5 If mycounta = 5 And mycountaplus Then Totalwon = won + wona + wonb + wonc + wond MsgBox ("JACKPOT!!! Plus $ " & Totalwon) GoTo Makeitzero Else wona = 1000000 + Totalwon End If End Select Select Case mycountb Case 0 If mycountb = 0 And mycountbplus Then wonb = 4 + Totalwon Else wonb = 0 End If Case 1 If mycountb = 1 And mycountbplus Then wonb = 4 + Totalwon Else wonb = 0 End If Case 2 If mycountb = 2 And mycountbplus Then wonb = 7 + Totalwon Else wonb = 0 End If Case 3 If mycountb = 3 And mycountbplus Then wonb = 100 + Totalwon Else wonb = 7 + Totalwon End If Case 4 If mycountb = 4 And mycountbplus Then wonb = 50000 + Totalwon Else wonb = 100 + Totalwon End If Case 5 If mycountb = 5 And mycountbplus Then Totalwon = won + wona + wonb + wonc + wond MsgBox ("JACKPOT!!! Plus $ " & Totalwon) GoTo Makeitzero Else wonb = 1000000 + Totalwon End If End Select Select Case mycountc Case 0 If mycountc = 0 And mycountcplus Then wonc = 4 + Totalwon Else wonc = 0 End If Case 1 If mycountc = 1 And mycountcplus Then wonc = 4 + Totalwon Else wonc = 0 End If Case 2 If mycountc = 2 And mycountcplus Then wonc = 7 + Totalwon Else wonc = 0 End If Case 3 If mycountc = 3 And mycountcplus Then wonc = 100 + Totalwon Else wonc = 7 + Totalwon End If Case 4 If mycountc = 4 And mycountcplus Then wonc = 50000 + Totalwon Else wonc = 100 + Totalwon End If Case 5 If mycountc = 5 And mycountcplus Then Totalwon = won + wona + wonb + wonc + wond MsgBox ("JACKPOT!!! Plus $ " & Totalwon) GoTo Makeitzero Else wonc = 1000000 + Totalwon End If End Select Select Case mycountd Case 0 If mycountd = 0 And mycountdplus Then wond = 4 + Totalwon Else wond = 0 End If Case 1 If mycountd = 1 And mycountdplus Then wond = 4 + Totalwon Else wond = 0 End If Case 2 If mycountd = 2 And mycountdplus Then wond = 7 + Totalwon Else wond = 0 End If Case 3 If mycountd = 3 And mycountdplus Then wond = 100 + Totalwon Else wond = 7 + Totalwon End If Case 4 If mycountd = 4 And mycountdplus Then wond = 50000 + Totalwon Else wond = 100 + Totalwon End If Case 5 If mycountd = 5 And mycountdplus Then Stop Totalwon = won + wona + wonb + wonc + wond MsgBox ("JACKPOT!!! Plus $ " & Totalwon) GoTo Makeitzero Else wond = 1000000 + Totalwon End If End Select Totalwon = won + wona + wonb + wonc + wond MsgBox ("You've won $" & Totalwon) Stop Makeitzero: mycountplus = 0 mycount = 0 mycounta = 0 mycountb = 0 mycountc = 0 mycountd = 0 Application.EnableEvents = True ' just to make sure events get turned on again. Unload EntryForm If Totalwon = 0 Then Range("I2").Value = ("-10") Else Range("I2").Value = (Totalwon) End If End Sub Private Sub Delete_Click() 'Rows(ActiveCell.Row).EntireRow.Delete Dim ws As Worksheet Dim rng As Range Set ws = ActiveSheet Set rng = ws.Range("a2:I2") rng.Delete Shift:=xlUp ans = MsgBox("Do you want to continue?", vbYesNo) If ans = vbYes Then Call Update Else Unload EntryForm End If End Sub Private Sub Find_Next_Click() Call Update End Sub Private Sub Previous_Click() lngR = lngR - 2 Call Update End Sub Sub Update() If lngR = 0 Then lngR = 2 Else lngR = lngR + 1 End If DateBox.Value = Sheet1.Range("A" & lngR).Text Ball1.Value = Sheet1.Range("B" & lngR).Text Ball2.Value = Sheet1.Range("C" & lngR).Text Ball3.Value = Sheet1.Range("D" & lngR).Text Ball4.Value = Sheet1.Range("E" & lngR).Text Ball5.Value = Sheet1.Range("F" & lngR).Text Power.Value = Sheet1.Range("G" & lngR).Text PowerPlay.Value = Sheet1.Range("H" & lngR).Text Winnings.Value = Sheet1.Range("I" & lngR).Text End Sub Private Sub NewRec_Click() Dim NR As Long, Ctrl As Control Application.EnableEvents = False With Sheets("Sheet1") NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1 .Range("A" & NR).Value = DateBox.Text .Range("B" & NR).Value = Ball1.Text .Range("C" & NR).Value = Ball2.Text .Range("D" & NR).Value = Ball3.Text .Range("E" & NR).Value = Ball4.Text .Range("F" & NR).Value = Ball5.Text .Range("G" & NR).Value = Power.Text .Range("H" & NR).Value = PowerPlay.Text .Range("I" & NR).Value = Winnings.Text .Range("A1:I" & NR).CurrentRegion.Sort .Range("A1"), xlDescending, Header:=xlYes, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom End With Application.EnableEvents = True Application.EnableEvents = False Dim cell As Range Dim mycount As Long Dim mycounta As Long Dim mycountb As Long Dim mycountc As Long Dim mycountd As Long Dim mycountplus As Long Dim mycountaplus As Long Dim mycountbplus As Long Dim mycountcplus As Long Dim mycountdplus As Long Dim Totalwon As Long Dim won As Long Dim wona As Long Dim wonb As Long Dim wonc As Long Dim wond As Long 'Stop For Each cell In Range("M12:Q12") If cell.DisplayFormat.Interior.Color = 12611584 Then mycount = mycount + 1 Next cell If Range("R12").DisplayFormat.Interior.Color = 12611584 Then mycountplus = 4 For Each cell In Range("M13:Q13") If cell.DisplayFormat.Interior.Color = 12611584 Then mycounta = mycounta + 1 Next cell If Range("R13").DisplayFormat.Interior.Color = 12611584 Then mycountaplus = 4 For Each cell In Range("M14:Q14") If cell.DisplayFormat.Interior.Color = 12611584 Then mycountb = mycountb + 1 Next cell If Range("R14").DisplayFormat.Interior.Color = 12611584 Then mycountbplus = 4 For Each cell In Range("M15:Q15") If cell.DisplayFormat.Interior.Color = 12611584 Then mycountc = mycountc + 1 Next cell If Range("R15").DisplayFormat.Interior.Color = 12611584 Then mycountcplus = 4 For Each cell In Range("M16:Q16") If cell.DisplayFormat.Interior.Color = 12611584 Then mycountd = mycountd + 1 Next cell If Range("R16").DisplayFormat.Interior.Color = 12611584 Then mycountdplus = 4 'Stop Total: Totalwon = 0 Select Case mycount Case 0 If mycount = 0 And mycountplus Then won = 4 + Totalwon Else won = 0 End If Case 1 If mycount = 1 And mycountplus Then won = 4 + Totalwon Else won = 0 End If Case 2 If mycount = 2 And mycountplus Then won = 7 + Totalwon Else won = 0 End If Case 3 If mycount = 3 And mycountplus Then won = 100 + Totalwon Else won = 7 + Totalwon End If Case 4 If mycount = 4 And mycountplus Then won = 50000 + Totalwon Else won = 100 + Totalwon End If Case 5 If mycount = 5 And mycountplus Then Totalwon = won + wona + wonb + wonc + wond MsgBox ("JACKPOT!!! Plus $ " & Totalwon) GoTo Makeitzero Else won = 1000000 + Totalwon End If End Select Select Case mycounta Case 0 If mycounta = 0 And mycountaplus Then wona = 4 + Totalwon Else wona = 0 End If Case 1 If mycounta = 1 And mycountaplus Then wona = 4 + Totalwon Else wona = 0 End If Case 2 If mycounta = 2 And mycountaplus Then wona = 7 + Totalwon Else wona = 0 End If Case 3 If mycounta = 3 And mycountaplus Then wona = 100 + Totalwon Else wona = 7 + Totalwon End If Case 4 If mycounta = 4 And mycountaplus Then wona = 50000 + Totalwon Else wona = 100 + Totalwon End If Case 5 If mycounta = 5 And mycountaplus Then Totalwon = won + wona + wonb + wonc + wond MsgBox ("JACKPOT!!! Plus $ " & Totalwon) GoTo Makeitzero Else wona = 1000000 + Totalwon End If End Select Select Case mycountb Case 0 If mycountb = 0 And mycountbplus Then wonb = 4 + Totalwon Else wonb = 0 End If Case 1 If mycountb = 1 And mycountbplus Then wonb = 4 + Totalwon Else wonb = 0 End If Case 2 If mycountb = 2 And mycountbplus Then wonb = 7 + Totalwon Else wonb = 0 End If Case 3 If mycountb = 3 And mycountbplus Then wonb = 100 + Totalwon Else wonb = 7 + Totalwon End If Case 4 If mycountb = 4 And mycountbplus Then wonb = 50000 + Totalwon Else wonb = 100 + Totalwon End If Case 5 If mycountb = 5 And mycountbplus Then Totalwon = won + wona + wonb + wonc + wond MsgBox ("JACKPOT!!! Plus $ " & Totalwon) GoTo Makeitzero Else wonb = 1000000 + Totalwon End If End Select Select Case mycountc Case 0 If mycountc = 0 And mycountcplus Then wonc = 4 + Totalwon Else wonc = 0 End If Case 1 If mycountc = 1 And mycountcplus Then wonc = 4 + Totalwon Else wonc = 0 End If Case 2 If mycountc = 2 And mycountcplus Then wonc = 7 + Totalwon Else wonc = 0 End If Case 3 If mycountc = 3 And mycountcplus Then wonc = 100 + Totalwon Else wonc = 7 + Totalwon End If Case 4 If mycountc = 4 And mycountcplus Then wonc = 50000 + Totalwon Else wonc = 100 + Totalwon End If Case 5 If mycountc = 5 And mycountcplus Then Totalwon = won + wona + wonb + wonc + wond MsgBox ("JACKPOT!!! Plus $ " & Totalwon) GoTo Makeitzero Else wonc = 100000 + Totalwon End If End Select Select Case mycountd Case 0 If mycountd = 0 And mycountdplus Then wond = 4 + Totalwon Else wond = 0 End If Case 1 If mycountd = 1 And mycountdplus Then wond = 4 + Totalwon Else wond = 0 End If Case 2 If mycountd = 2 And mycountdplus Then wond = 7 + Totalwon Else wond = 0 End If Case 3 If mycountd = 3 And mycountdplus Then wond = 100 + Totalwon Else wond = 7 + Totalwon End If Case 4 If mycountd = 4 And mycountdplus Then wond = 50000 + Totalwon Else wond = 100 + Totalwon End If Case 5 If mycountd = 5 And mycountdplus Then Totalwon = won + wona + wonb + wonc + wond MsgBox ("JACKPOT!!! Plus $ " & Totalwon) GoTo Makeitzero Else wond = 1000000 + Totalwon End If End Select Totalwon = won + wona + wonb + wonc + wond If Totalwon = 0 Then Range("I2").Value = ("-10") Else Range("I2").Value = (Totalwon) End If MsgBox ("You've won $ " & Totalwon) 'Sheet1 ("J2" = ("$" & Totalwon)) Makeitzero: mycountplus = 0 mycount = 0 mycounta = 0 mycountb = 0 mycountc = 0 mycountd = 0 Dim ctl For Each ctl In Me.Controls If TypeOf ctl Is msforms.TextBox Then ctl.Text = "" End If Next ctl DateBox.SetFocus Application.EnableEvents = True ' just to make sure events get turned on again. End Sub Private Sub UserForm_Activate() DateBox.Text = Range("A2").Text Ball1.Text = Range("B2").Text Ball2.Text = Range("C2").Text Ball3.Text = Range("D2").Text Ball4.Text = Range("E2").Text Ball5.Text = Range("F2").Text Power.Text = Range("G2").Text PowerPlay.Text = Range("H2").Text Winnings.Text = Range("I2").Text 'TextBox1.Text = Sheets("Data").Range("B4").Text End Sub Private Sub UserForm_Initialize() currentRow = 1 End Sub.Range("A1:I" & NR).CurrentRegion.Sort .Range("A1"), xlDescending, Header:=xlYes, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottomThis line is in the CloseandSave Sub
TIA
13 Replies
You may have cells merged that you don't realize. Maybe try typing this into the immediate window and confirm with enter. Then try running the code again.
Sheets("Sheet1").Cells.UnmergeYou're correct you can't upload macro enabled files due to security risks. If you still have an issue after trying the above fix you could try uploading it to a third party site like DropBox, Box or FileSnack and posting the link to the community.
Still a problem. Here is a link to the file. https://www.dropbox.com/s/fysi14j70lespbl/test2.xlsm?dl=0
When you use CurrentRegion it selects all of the cells in this range A1:AA2139. Cells in this range include merged cells L8:O8, W6:X6, W8:X8. It appears that you want to sort only A1:I2139. In order to do this just change the sort code to this:
.Range("A1:I" & NR).Sort .Range("A1"), xlDescending, Header:=xlYes, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottomI think CurrentRegion is also used in sorts in a few other places in your code. You will most likely need to correct all of the instances of this issue.
Hope this helps.
