VBA Userchecksubroutine skips code

M

mysticmario

Active Member
Joined
Nov 10, 2021
Messages
323
Office Version
  1. 365
Platform
  1. Windows
Hi when i execute this code:
VBA Code: 
Sub FileSystemObj()
Sheets("KARTA REALIZACJI").Visible = True
Application.ScreenUpdating = False
  Dim line As String
  Dim FSO As Object
  Dim TS As Object
  Dim PATH As String
  Dim usercheck As String
  usercheck = InputBox("Podaj hasło dostępu", "Hasło")
  
  If usercheck = "witek" Then
  Sheets("Admin").Range("CurrentUsr").Value = "Witold"
        PATH = Sheets("Admin").Range("A31").Value
    ElseIf usercheck = "konrad" Then
    Sheets("Admin").Range("CurrentUsr").Value = "Konrad"
        PATH = Sheets("Admin").Range("A32").Value
    ElseIf usercheck = "damian" Then
    Sheets("Admin").Range("CurrentUsr").Value = "Damian"
        PATH = Sheets("Admin").Range("A33").Value
    ElseIf usercheck = "admin" Then
    Sheets("Admin").Range("CurrentUsr").Value = "Mariusz"
        PATH = Sheets("Admin").Range("A34").Value
    Else: MsgBox "Błędne hasło": Exit Sub
          
  Set FSO = CreateObject("Scripting.FileSystemObject")
  Set TS = FSO.OpenTextFile(PATH)
  Sheets("KARTA REALZIACJI").Range("B150").Select
  Do While Not TS.AtEndOfStream
     line = TS.ReadLine
     ActiveCell = line
     ActiveCell.Offset(1, 0).Select
  Loop
  TS.Close
  Set TS = Nothing
  Set FSO = Nothing
Application.ScreenUpdating = True
Sheets("KARTA REALZIACJI").Range("D148").Value = Date
End If
Sheets("KARTA REALIZACJI").Visible = False
End Sub
after usercheck all of this is skipped:
VBA Code: 
Set FSO = CreateObject("Scripting.FileSystemObject")
  Set TS = FSO.OpenTextFile(PATH)
  Sheets("KARTA REALZIACJI").Range("B150").Select
  Do While Not TS.AtEndOfStream
     line = TS.ReadLine
     ActiveCell = line
     ActiveCell.Offset(1, 0).Select
  Loop
  TS.Close
  Set TS = Nothing
  Set FSO = Nothing
Application.ScreenUpdating = True
Sheets("KARTA REALZIACJI").Range("D148").Value = Date
I run this code a lot without usercheck in a different **** withotu a problem.
Any idea why this happens?
 

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.
Sort by date Sort by votes
Because you have Exit Sub right before that and in the same Else block of your If clause.
 
Upvote 0
RoryA said:
Because you have Exit Sub right before that and in the same Else block of your If clause.
Click to expand...
I changed that to
VBA Code: 
Else: MsgBox "Błędne hasło": GoTo LineA
the same thing
So i I left only
VBA Code: 
Else: MsgBox "Błędne hasło"
and still same issue
 
Upvote 0
The subsequent lines will now only execute if the usercheck variable does not match one of the ones specified in the If..ElseIf blocks.
 
Upvote 0
To make it clearer, this is how your code is currently structured, with proper indenting (and removing the colons for clarity):

VBA Code: 
Sub FileSystemObj()
   Sheets("KARTA REALIZACJI").Visible = True
   Application.ScreenUpdating = False
   Dim line As String
   Dim FSO As Object
   Dim TS As Object
   Dim PATH As String
   Dim usercheck As String
   usercheck = InputBox("Podaj haslo dostepu", "Haslo")
   
   If usercheck = "witek" Then
      Sheets("Admin").Range("CurrentUsr").Value = "Witold"
      PATH = Sheets("Admin").Range("A31").Value
   ElseIf usercheck = "konrad" Then
      Sheets("Admin").Range("CurrentUsr").Value = "Konrad"
      PATH = Sheets("Admin").Range("A32").Value
   ElseIf usercheck = "damian" Then
      Sheets("Admin").Range("CurrentUsr").Value = "Damian"
      PATH = Sheets("Admin").Range("A33").Value
   ElseIf usercheck = "admin" Then
      Sheets("Admin").Range("CurrentUsr").Value = "Mariusz"
      PATH = Sheets("Admin").Range("A34").Value
   Else
      MsgBox "Bledne haslo"
      Exit Sub '<- you say you have removed this now
      
      Set FSO = CreateObject("Scripting.FileSystemObject")
      Set TS = FSO.OpenTextFile(PATH)
      Sheets("KARTA REALZIACJI").Range("B150").Select
      Do While Not TS.AtEndOfStream
         line = TS.ReadLine
         ActiveCell = line
         ActiveCell.Offset(1, 0).Select
      Loop
      TS.Close
      Set TS = Nothing
      Set FSO = Nothing
      Application.ScreenUpdating = True
      Sheets("KARTA REALZIACJI").Range("D148").Value = Date
      
   End If
   
   Sheets("KARTA REALIZACJI").Visible = False
End Sub
 
Upvote 0
Alright I placed GoTo LineB after usecheck is met and LineB is the rest of the code and it works
 
Upvote 0
Other than in an On Error statement, Goto is best avoided and rarely necessary. I suspect you just need to put the End If line further up...
 
Upvote 0
RoryA said:
To make it clearer, this is how your code is currently structured, with proper indenting (and removing the colons for clarity):

VBA Code: 
Sub FileSystemObj()
   Sheets("KARTA REALIZACJI").Visible = True
   Application.ScreenUpdating = False
   Dim line As String
   Dim FSO As Object
   Dim TS As Object
   Dim PATH As String
   Dim usercheck As String
   usercheck = InputBox("Podaj haslo dostepu", "Haslo")
  
   If usercheck = "witek" Then
      Sheets("Admin").Range("CurrentUsr").Value = "Witold"
      PATH = Sheets("Admin").Range("A31").Value
   ElseIf usercheck = "konrad" Then
      Sheets("Admin").Range("CurrentUsr").Value = "Konrad"
      PATH = Sheets("Admin").Range("A32").Value
   ElseIf usercheck = "damian" Then
      Sheets("Admin").Range("CurrentUsr").Value = "Damian"
      PATH = Sheets("Admin").Range("A33").Value
   ElseIf usercheck = "admin" Then
      Sheets("Admin").Range("CurrentUsr").Value = "Mariusz"
      PATH = Sheets("Admin").Range("A34").Value
   Else
      MsgBox "Bledne haslo"
      Exit Sub '<- you say you have removed this now
     
      Set FSO = CreateObject("Scripting.FileSystemObject")
      Set TS = FSO.OpenTextFile(PATH)
      Sheets("KARTA REALZIACJI").Range("B150").Select
      Do While Not TS.AtEndOfStream
         line = TS.ReadLine
         ActiveCell = line
         ActiveCell.Offset(1, 0).Select
      Loop
      TS.Close
      Set TS = Nothing
      Set FSO = Nothing
      Application.ScreenUpdating = True
      Sheets("KARTA REALZIACJI").Range("D148").Value = Date
     
   End If
  
   Sheets("KARTA REALIZACJI").Visible = False
End Sub
Click to expand...
Does the indenting actually matter other than visual refference?
 
Upvote 0
RoryA said:
Other than in an On Error statement, Goto is best avoided and rarely necessary. I suspect you just need to put the End If line further up...
Click to expand...
I didnt use on error I just used GoTo
VBA Code: 
Sub FileSystemObj()
Sheets("KARTA REALIZACJI").Visible = True
Application.ScreenUpdating = False
  Dim line As String
  Dim FSO As Object
  Dim TS As Object
  Dim PATH As String
  Dim usercheck As String
LineA:  usercheck = InputBox("Podaj hasło dostępu", "Hasło")
  
  If usercheck = "witek" Then
  Sheets("Admin").Range("CurrentUsr").Value = "Witold"
        PATH = Sheets("Admin").Range("A31").Value
        GoTo LineB
    ElseIf usercheck = "konrad" Then
        Sheets("Admin").Range("CurrentUsr").Value = "Konrad"
        PATH = Sheets("Admin").Range("A32").Value
        GoTo LineB
    ElseIf usercheck = "damian" Then
        Sheets("Admin").Range("CurrentUsr").Value = "Damian"
        PATH = Sheets("Admin").Range("A33").Value
        GoTo LineB
    ElseIf usercheck = "admin" Then
        Sheets("Admin").Range("CurrentUsr").Value = "Mariusz"
        PATH = Sheets("Admin").Range("A34").Value
        GoTo LineB
    Else
        MsgBox "Błędne hasło"
        GoTo LineA
          
LineB:  Set FSO = CreateObject("Scripting.FileSystemObject")
  Set TS = FSO.OpenTextFile(PATH)
  Sheets("KARTA REALZIACJI").Range("B150").Select
  Do While Not TS.AtEndOfStream
     line = TS.ReadLine
     ActiveCell = line
     ActiveCell.Offset(1, 0).Select
  Loop
  TS.Close
  Set TS = Nothing
  Set FSO = Nothing
Application.ScreenUpdating = True
Sheets("KARTA REALZIACJI").Range("D148").Value = Date
End If
Sheets("KARTA REALIZACJI").Visible = False
End Sub
 
Upvote 0
mysticmario said:
I didnt use on error I just used GoTo
Click to expand...
I know - what I said was that Goto is best avoided if it is not in an On Error line (like here). There is literally no need for it here - just move the End If line up before the Set FSO = ... line
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Solved
exporting userform - doesn't work for other PC than mine
Replies
9
Views
410
Kyle123
Kyle123
G
  • Question
Email from Excel query
Replies
0
Views
187
gmazza76
G
C
  • Question
VBA - Email specific range and attach Sheet1
Replies
4
Views
519
Clermont
C
A
  • Question
Ron de Bruin VBA
Replies
2
Views
1K
Alexfoots
A
J
  • Question
Kill Temp File
Replies
1
Views
357
ExcelToDAX
E

Forum statistics

Threads
1,215,465
Messages
6,124,977
Members
449,200
Latest member
Jamil ahmed

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