Conflicting Codes Help Please

[pure vito]

Hi All,

I'm having an issue having both these codes in the same user form might anyone know why I think its to do with the loop but I'm not sure I'm also not sure how to have these codes work on the same user form,
I'd really appreciate any help, thanks in advance.

 'Force variable declaration
Option Explicit
 
 'Variable for controlling if the animation should continue to run
Dim Running         As Boolean
 
Private Sub CommandButton1_Click() 'Close Command Button
     
     'Dismiss the userform
    Unload Me
     
End Sub
 




Private Sub UserForm_Activate()
     
     'Set Running to true, while true the animations will continue to run
    Running = True
     'Start the animation sub
    Call Animation
     
End Sub
 
Private Sub Animation()
     
    Dim X               As Integer
    Dim Y               As Integer
    Dim Z               As Integer
    Dim MyTimer         As Double
     
    DoEvents
    X = 1
    Y = 1
    X = 1
    MyTimer = Timer
    Do
        On Error Resume Next
        Subs.Image3.Picture = LoadPicture _
        (ThisWorkbook.Path & "\Images\Animation\Gyrados\" & X & ".Gif")
        Subs.Image4.Picture = LoadPicture _
        (ThisWorkbook.Path & "\Images\Animation\Pulser\" & Y & ".Gif")
        Subs.Image5.Picture = LoadPicture _
        (ThisWorkbook.Path & "\Images\Animation\Pikachu\" & Z & ".Gif")
        On Error GoTo 0
        Do
        Loop While Timer - MyTimer < 0.1
        If X = 8 Then
            X = 1
        Else
            X = X + 1
        End If
        If Y = 11 Then
            Y = 1
        Else
            Y = Y + 1
        End If
         If Z = 4 Then
            Z = 1
        Else
            Z = Z + 1
        End If
        MyTimer = Timer
        DoEvents
    Loop While Running
     
End Sub
 
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
     
     'Set running to False to stop the animation
    Running = False
     
End Sub

Private Sub addcard_Click()

    Dim t As Long
    Dim S As String
    Dim X As Variant 'array
    
    Application.ScreenUpdating = False
    
    Sheets("Series").Select
    Sheets("Subs").Visible = True
    
    Sheets("Subs").Activate
    ActiveSheet.Range("B1").Activate

    Do While IsEmpty(ActiveCell.Offset(t, 0)) = False
        t = t + 1
    Loop

    ActiveCell.Offset(t, 0).Activate 'The Empty Cell

    S = cardname.Value
    X = Split(S, Chr(10)) 'your bookingparts.value split into an array. if chr(10) doesn't work, try chr(13) or vbNewLine or vbCrLf
    i = 0 'just a counter
    
    For Each v In X
        ActiveCell.Offset(i, 0).Value = CleanTrim(v)
        i = i + 1
    Next v
  
  Sheets("Subs").Activate
    ActiveSheet.Range("C1").Activate

    Do While IsEmpty(ActiveCell.Offset(t, 0)) = False
        t = t + 1
    Loop

    ActiveCell.Offset(t, 0).Activate 'The Empty Cell

    q = cardnumber.Value
    X = Split(q, Chr(10)) 'your bookingparts.value split into an array. if chr(10) doesn't work, try chr(13) or vbNewLine or vbCrLf
    i = 0 'just a counter
    
    For Each v In X
        ActiveCell.Offset(i, 0).Value = CleanTrim(v)
        i = i + 1
    Next v
 
  Sheets("Subs").Activate
    ActiveSheet.Range("D1").Activate

    Do While IsEmpty(ActiveCell.Offset(t, 0)) = False
        t = t + 1
    Loop

    ActiveCell.Offset(t, 0).Activate 'The Empty Cell

    f = grader.Value
    X = Split(f, Chr(10)) 'your bookingparts.value split into an array. if chr(10) doesn't work, try chr(13) or vbNewLine or vbCrLf
    i = 0 'just a counter
    
    For Each v In X
        ActiveCell.Offset(i, 0).Value = CleanTrim(v)
        i = i + 1
    Next v
   
   Sheets("Subs").Activate
    ActiveSheet.Range("E1").Activate

    Do While IsEmpty(ActiveCell.Offset(t, 0)) = False
        t = t + 1
    Loop

    ActiveCell.Offset(t, 0).Activate 'The Empty Cell

    j = predgrade.Value
    X = Split(j, Chr(10)) 'your bookingparts.value split into an array. if chr(10) doesn't work, try chr(13) or vbNewLine or vbCrLf
    i = 0 'just a counter
    
    For Each v In X
        ActiveCell.Offset(i, 0).Value = CleanTrim(v)
        i = i + 1
    Next v
 
    Sheets("Subs").Activate
    ActiveSheet.Range("F1").Activate

    Do While IsEmpty(ActiveCell.Offset(t, 0)) = False
        t = t + 1
    Loop

    ActiveCell.Offset(t, 0).Activate 'The Empty Cell

    j = eta.Value
    X = Split(j, Chr(10)) 'your bookingparts.value split into an array. if chr(10) doesn't work, try chr(13) or vbNewLine or vbCrLf
    i = 0 'just a counter
    
    For Each v In X
        ActiveCell.Offset(i, 0).Value = CleanTrim(v)
        i = i + 1
    Next v
    
    Range("I1").Select
    Selection.End(xlDown).Select
    Selection.Copy
    Range("G1").Select
    Selection.End(xlDown).Select
    Selection.Offset(1, 0).Select
    ActiveSheet.Paste
 
 
 'msg box
 Dim UserResponse As Integer

UserResponse = MsgBox("Good Luck On Those Grades! Yes To Continue", vbYesNo, "Cards Added To DataBase")

If UserResponse = vbYes Then

'Your command for a yes answer goes here

Else

'Your command for a no answer goes here

End If
 
    showall_Click
        Sheets("Subs").Select
    ActiveWindow.SelectedSheets.Visible = False
    Sheets("Series").Select
    Application.ScreenUpdating = True

End Sub

 

[sijpie]

You are not very clear what isn't working and where you think the hickup is.
Is it that the userform doesn't react to a user keypress? or something else??

By the way your method to loop through the various cards can be written more efficiently and neater

        Loop While Timer - MyTimer < 0.1
        
            x = (x Mod 8) + 1
            Y = (Y Mod 11) + 1
            Z = (Z Mod 4) + 1
            
        MyTimer = Timer

 

[pure vito]

Thank you very much for you help and apologies for the vague question, i have since decided not to use the code within the user form but on my home page instead it works well and now even better thanks to your advise on cleaning up the code, much appreciated