Puzzeled

J

jarhead58

Active Member
Joined
Sep 21, 2017
Messages
364
Office Version
  1. 2021
Platform
  1. Windows
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?

TIA
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Sort by date Sort by votes
jarhead58 said:
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?

TIA
Click to expand...

UPDATE!

Sorry for the confusion on my part!

Code: 
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
 
Upvote 0
This is where it hangs in the CloseandSave Sub

Code: 
[COLOR=#ffff00][/COLOR].Range("A1:I" & NR).CurrentRegion.Sort .Range("A1"), xlDescending, Header:=xlYes, _[COLOR=#ffff00]
[/COLOR][COLOR=#ffff00][/COLOR]
                        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom[COLOR=#ffff00][/COLOR]
 
Upvote 0
Select the usedrange, right click, Format cells, Alignment, what (if anything) is in the checkbox by Merge cells?
 
Upvote 0
Yeah, nothing! The funny part is, 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.
 
Upvote 0
I've never come across that behaviour & cannot replicate, so unfortunately cannot offer any solution.
 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Question
Sorting columns with different size merged cells
Replies
1
Views
182
6StringJazzer
6StringJazzer
C
  • Solved
Merge based on Merged area of adjacent columns
Replies
2
Views
704
CodeNewb
C
D
  • Question
Merging cells based on the merging in another column and SUM them up
Replies
1
Views
483
Kerryx
K
FatalLordes
  • Question
Looking for duplicates and merging data
Replies
3
Views
1K
FatalLordes
FatalLordes
S
  • Solved
VBA merge cells in another column based on already merged cells. Possible?
Replies
2
Views
398
SwanB
S

Forum statistics

Threads
1,216,051
Messages
6,128,501
Members
449,455
Latest member
jesski

Share this page

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