VBA to call a sheet and copy userform values

[Kelly05201]

Hi all...
Ever get burnt out? The more code you write, the further you are from your objective? I knew you'd understand.

Here's the fast summary of this userform action:
Check to see if a workbook exists -

fileName:="C:\Users\admin\desktop\KELLY'S CRAP\cambridge\Autosaves\Event " & Format(Date, yyyymmdd) & ".xlsm"

If it exists, is it open? If not open, open it. Once open, Worksheet("Registration").Activate
Then copy some userform values to the last line.
If the workbook doesn't exists, toss up a message box and end the sub.

No biggie, right? My code is sooooo bloated and still doesn't work!

Dim wBook As Workbook
    On Error Resume Next
    Set wBook = Workbooks("Event " & Format(Date, yyyymmdd) & ".xlsm")

If FileThere("C:\Users\admin\Desktop\KELLY'S CRAP\cambridge\Autosaves\Event " & Format(Date, yyyymmdd) & ".xlsm") Then
        MsgBox ("found the magic file")
        If wBook Is Nothing Then 'Not open
            MsgBox ("Workbook exists, but is not open")
                        Set wBook = Nothing
            On Error GoTo 0
            Workbooks.Open _
                FileName:="C:\Users\admin\desktop\KELLY'S CRAP\cambridge\Autosaves\Event " & Format(Date, yyyymmdd) & ".xlsm", _
                ReadOnly:=False
        Else 'It is open
            Dim EVFNAME As String
            EVFNAME = "Event " & Format(Date, yyyymmdd) & ".xlsm"
            MsgBox (EVFNAME & " is currently open")
            
            Workbooks(EVFNAME).Activate
         
        End If
'  IT'S RIGHT ABOUT HERE WHERE THE CODE FALLS ON ITS FACE, but the rest is silly bloated too.
    Dim wst As Worksheet
    Dim iRow As Long
    Set wst = ActiveWorkbook.Sheets("Registration")
    Sheets(wst).Activate
    'find first empty row in database
    iRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    
    'copy the userform values to the event sheet that reflects today's date
    Cells(iRow, 1).Value = Me.FIRSTNAME.Value
    Cells(iRow, 2).Value = Me.LASTNAME.Value

Else
MsgBox ("There is no book created for today's event. In order to add this person to today's event, the workbook must exist FIRST.")
End If

Application.ScreenUpdating = True
Unload Me
End Sub

Thank you soooooo much in advance!

 

[MUKESHY12390]

perhaps this....

Option Explicit


Sub tryThis()
Dim opath As String
Dim File As Variant
Dim ws As Worksheet
Dim ShtRegst As Boolean
Dim oWrk As Workbook
Dim iRow As Long


ShtRegst = False
opath = "C:\Users\e599748\Desktop\CREU - TLP - Cash Self Check Tool" & Application.PathSeparator  ''''path change Here
opath = opath & "Event" & Format(Date, yyyymmdd) '''Name Change Here
opath = opath & ".xlsm"   ''Extension change here




File = Dir(opath)


If Len(File) > 0 Then
  MsgBox (File & " Exists")
  
  Set oWrk = Workbooks.Open(opath)
  
  If InStr(1, oWrk.Name, "Read-Only", vbTextCompare) = 0 Then   ''to check ReadOnly
    
      For Each ws In oWrk.Worksheets
        If InStr(1, ws.Name, "Registration", vbTextCompare) <> 0 Then   '' To confirm Registration sheet status
            ShtRegst = True
            ws.Activate
            iRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
            ws.Cells(iRow, 1).Value = "ok_FirstName"  'Me.FIRSTNAME.Value
            ws.Cells(iRow, 2).Value = "ok_LastName"  'Me.LASTNAME.Value
        End If
      Next ws
  Else
    MsgBox "Workbook is Already Opened"
    Exit Sub
  End If
    If ShtRegst = False Then MsgBox "Registration worksheet not found"
Else
  MsgBox (opath & " Doesn't Exists")
End If


End Sub

 

[Kelly05201]

perhaps this....

Option Explicit


Sub tryThis()
Dim opath As String
Dim File As Variant
Dim ws As Worksheet
Dim ShtRegst As Boolean
Dim oWrk As Workbook
Dim iRow As Long


ShtRegst = False
opath = "C:\Users\e599748\Desktop\CREU - TLP - Cash Self Check Tool" & Application.PathSeparator  ''''path change Here

I'm clueless what a "e599748\Desktop\CREU - TLP - Cash Self Check Tool" & Application.PathSeparator" is.

opath = opath & "Event" & Format(Date, yyyymmdd) '''Name Change Here
opath = opath & ".xlsm"   ''Extension change here

File = Dir(opath)

Why the complex building of this string "opath"?
The file will always reside here: C:\Users\admin\desktop\KELLY'S CRAP\cambridge\Autosaves\
and have the filename: "Event " & Format(Date, yyyymmdd) & ".xlsm"
Either an exact match will exist or not...

If Len(File) > 0 Then
  MsgBox (File & " Exists")
  
  Set oWrk = Workbooks.Open(opath)
  
  If InStr(1, oWrk.Name, "Read-Only", vbTextCompare) = 0 Then   ''to check ReadOnly
    
      For Each ws In oWrk.Worksheets
        If InStr(1, ws.Name, "Registration", vbTextCompare) <> 0 Then   '' To confirm Registration sheet status
            ShtRegst = True
            ws.Activate

Also unnecessary... if the workbook exists, the sheet "Registration" will definitely exist.. no need to check for it.

            iRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
            ws.Cells(iRow, 1).Value = "ok_FirstName"  'Me.FIRSTNAME.Value
            ws.Cells(iRow, 2).Value = "ok_LastName"  'Me.LASTNAME.Value
        End If
      Next ws
  Else
    MsgBox "Workbook is Already Opened"
    Exit Sub
  End If
    If ShtRegst = False Then MsgBox "Registration worksheet not found"
Else
  MsgBox (opath & " Doesn't Exists")
End If


End Sub

I'm willing to learn the nuts and bolts of your idea though!

 

[MUKESHY12390]

ShtRegst = False
opath = "C:\Users\e599748\Desktop\CREU - TLP - Cash Self Check Tool" & Application.PathSeparator ''' ''''''just this path with yours.
opath = opath & "Event" & Format(Date, yyyymmdd) '''Name Change Here
opath = opath & ".xlsm" ''Extension change here

change path with yours.

----------------------------------------------
Opath ----I love to follow "Option Explicit" with less number of variable , in big project more variable for same purpose confuse me.

Also unnecessary... if the workbook exists, the sheet "Registration" will definitely exist.. no need to check for it.

As developer , its your job to assume all possible error, which could come in future otherwise "Client/customer" have to chase you every time when error occur.As long as you making macro for yourself then it is completely OK.

 

[Kelly05201]

Modify as needed, and works nicely!!! Thank you, MUKESHY12390 !

 

[MUKESHY12390]

glad it worked out.