Long VB If statement need shortened

[autigers]

Is there a better way to set this code up ?

Private Sub Workbook_Open()

On Error GoTo TheEnd

Sheets("Config").Activate
If Environ("username") = ("ouaaye") Then
        With Sheets("Config")
        TheAns = FindColumn(.Name, Environ("username"))
        ans = Cells(2, TheAns)
        MsgBox "The password to access the VB environment is  " & ans & "     Figure you earned it !!"
End With
End If
If Environ("username") = ("OWNER") Then
        With Sheets("Config")
        TheAns = FindColumn(.Name, Environ("username"))
        ans = Cells(2, TheAns)
        MsgBox "The password to access the VB environment is  " & ans & "                             :O)"
End With
End If
If Environ("username") = ("inakgr") Then
        With Sheets("Config")
        TheAns = FindColumn(.Name, Environ("username"))
        ans = Cells(2, TheAns)
        MsgBox "The password to access the VB environment is  " & ans & "                             :O)"
End With
End If
If Environ("username") = ("appjcl") Then
        With Sheets("Config")
        TheAns = FindColumn(.Name, Environ("username"))
        ans = Cells(2, TheAns)
        MsgBox "The password to access the VB environment is  " & ans & "                             :O)"
End With
End If
If Environ("username") = ("inabgi") Then
        With Sheets("Config")
        TheAns = FindColumn(.Name, Environ("username"))
        ans = Cells(2, TheAns)
        MsgBox "The password to access the VB environment is  " & ans & "                             :O)"
End With
End If
Application.ScreenUpdating = False

 

[autigers]

Okay .... Same code ... a second variable though .... SInce this workbook will be used by 2 shifts (1st and 3rd), it must needs be that the table for storage of the info allow a record for each shift on the same day....
I've tried looking at both columns but with no luck ... Not sure how to set the code up for multiple variables ....
ColumnA = "Sdate"
ColumnB= "Shift"

Currently it does a great job of finding the current date and then option to overwrite, or simply insert new record ...

The code is below

Private Sub CommandButton1_Click()
'AUTHOR: FATCAT (Mr.Excel.com)
Sheets("DailyProd").Visible = True
Sheets("DailyProd").Select

Dim what As Variant
Dim sht1 As Worksheet

what = Me.Sdate.Value                             'this is what to look for
Set sht1 = Sheets("DailyProd")                  'this is the sheet to look in

With sht1.Range("A:A")                          'look at column A
    Set j = .Find(what, LookIn:=xlValues)
    
    If Not j Is Nothing Then                    'we found the text
        ans = MsgBox("There is a record already created for" & Me.Sdate.Text & vbCr & vbCr & "Confirm OVERWRITE of existing data ?", vbYesNoCancel, "Overwrite Data ?")
      Select Case ans
        Case 6                                  'Yes
           Set Targetcell = Range(j.Address)
           Sheets("Log").Visible = True
           Sheets("Log").Select
            Range("B65536").End(xlUp).Offset(1, 0).Value = UserName
            Range("C65536").End(xlUp).Offset(1, 0).Value = NameOfComputer
            Range("D65536").End(xlUp).Offset(1, 0).Value = Date
            Range("D65536").End(xlUp).NumberFormat = "dd mmm yyyy"
            Range("E65536").End(xlUp).Offset(1, 0).Value = Time
            Range("G65536").End(xlUp).Offset(1, 0).Value = "Procedure Error - DailyProd record exists for  " & Date 'add code here for logging etc
        
        Case Else                               'No, Cancel or X
           Exit Sub
        End Select
    Else                                        'we didn't find it
        Set Targetcell = Range(Range("A65536").End(xlUp).Address).Offset(1, 0)
    End If
End With

Call TransferData(Targetcell.Address)           'call the data transfer sub passing the target cell address

End Sub

 

[autigers]

Anyone ???

 

[XLGibbs]

Do you want to have two separate tables? one for each shift...

OR

Do you want to have an extra column in the table that identifes the shift

 

[autigers]

Do you want to have two separate tables? one for each shift...

I was thinking that this may be the best approach.


[/quote]
Do you want to have an extra column in the table that identifes the shift[/quote]
I already have this in column B of the table ....

I imagine it would be easier in the long run to set up 2 tables ???

 

[XLGibbs]

Well in general, if there were two tables, and hence two sheets.

you could just set the Sh1 reference according to which ****

Example:

If Shift = "First" then Set Sh1 = Sheets("DailyProd")
If Shift = "Third" then Set Sh1 = Sheets("DailyProd2")

the code beneath it references Sh1, so if each table were set up the same, this would be the easiest short term fix. Obviously change the syntax above to suit based on how you want to identify "shift"

 

[autigers]

Got it !!
After 4 non-stop weeks of this ... me thinks my brain is

 

[autigers]

Okay ... I've created 2 sheets one for each shift.
What I need help with now is how do I keep from having to go back through all of my code and changing only the sheet that the data will be sent to based on the the time of day ??
Is there a way to set a shift for all code to run from at workbook open ... that way all of the code can just look at that rather than typing out 2 subs for everything the workbook does .....
I will paste an example ....

Okay buttn

Private Sub CommandButton1_Click()
If Time > 0.5 Then
    Shift1
Else
    Shift2
End If
End Sub

Sub Shift1()
Dim what As Variant                             'this is what to look for
Dim sht1 As Worksheet                           'this is the sheet to look in

Set sht1 = Sheets("DailyProd")
    sht1.Visible = True
    sht1.Select

what = Me.Sdate.Value & Me.Shift.Value
With sht1.Range("A:A")
    Set j = .Find(what, LookIn:=xlValues)
If Not j Is Nothing Then                        'we found the text
        ans = MsgBox("There is a record already created for" & Me.Sdate.Text & vbCr & vbCr & "Confirm OVERWRITE of existing data ?", vbYesNoCancel, "Overwrite Data ?")
      Select Case ans
        Case 6                                  'Yes
         Set Targetcell = Range(j.Address)
          Sheets("Log").Visible = True
           Sheets("Log").Select
            Range("B65536").End(xlUp).Offset(1, 0).Value = UserName
            Range("C65536").End(xlUp).Offset(1, 0).Value = NameOfComputer
            Range("D65536").End(xlUp).Offset(1, 0).Value = Date
            Range("D65536").End(xlUp).NumberFormat = "dd mmm yyyy"
            Range("E65536").End(xlUp).Offset(1, 0).Value = Time
            Range("G65536").End(xlUp).Offset(1, 0).Value = "Procedure Error - DailyProd record exists for  " & Date 'add code here for logging etc
           Case Else                               'No, Cancel or X
          Exit Sub
        End Select
    Else                                        'we didn't find it
        Set Targetcell = Range(Range("A65536").End(xlUp).Address).Offset(1, 0)
    End If
End With
       
Call TransferData(Targetcell.Address)           'call the data transfer sub passing the target cell address
   
End Sub

Shift 3rd

Sub Shift2()
Dim what As Variant                             'this is what to look for
Dim sht2 As Worksheet                           'this is the sheet to look in

Set sht2 = Sheets("DailyProd2")
    sht2.Visible = True
    sht2.Select

what = Me.Sdate.Value & Me.Shift.Value
With sht1.Range("A:A")
    Set j = .Find(what, LookIn:=xlValues)
If Not j Is Nothing Then                        'we found the text
        ans = MsgBox("There is a record already created for" & Me.Sdate.Text & vbCr & vbCr & "Confirm OVERWRITE of existing data ?", vbYesNoCancel, "Overwrite Data ?")
      Select Case ans
        Case 6                                  'Yes
         Set Targetcell = Range(j.Address)
          Sheets("Log").Visible = True
           Sheets("Log").Select
            Range("B65536").End(xlUp).Offset(1, 0).Value = UserName
            Range("C65536").End(xlUp).Offset(1, 0).Value = NameOfComputer
            Range("D65536").End(xlUp).Offset(1, 0).Value = Date
            Range("D65536").End(xlUp).NumberFormat = "dd mmm yyyy"
            Range("E65536").End(xlUp).Offset(1, 0).Value = Time
            Range("G65536").End(xlUp).Offset(1, 0).Value = "Procedure Error - DailyProd record exists for  " & Date 'add code here for logging etc
           Case Else                               'No, Cancel or X
          Exit Sub
        End Select
    Else                                        'we didn't find it
        Set Targetcell = Range(Range("A65536").End(xlUp).Address).Offset(1, 0)
    End If
End With
       
Call TransferData2(Targetcell.Address)           'call the data transfer sub passing the target cell address
   
End Sub

After this comes yet another sub ... for each shift .... everything is identical except for which sheet it will select .....

 

[Fat Cat]

Hi ya, try sending the sheet name to the shift sub when you call it, then you can use the one sub to do both.

Example;

Private Sub CommandButton1_Click() 
If Time > 0.5 Then 
    Call Shift("DailyProd") 
Else 
    Call Shift("DailyProd2") 
End If 
End Sub

Sub Shift(ByVal shtName as string) 
Dim what As Variant                               'this is what to look for 
Dim sht1 As Worksheet                           'this is the sheet to look in 

Set sht1 = Sheets(shtName) 
    sht1.Visible = True 
    sht1.Select 

what = Me.Sdate.Value & Me.Shift.Value 
With sht1.Range("A:A") 
    Set j = .Find(what, LookIn:=xlValues) 
If Not j Is Nothing Then                        'we found the text 
        ans = MsgBox("There is a record already created for" & Me.Sdate.Text & vbCr & vbCr & "Confirm OVERWRITE of existing data ?", vbYesNoCancel, "Overwrite Data ?") 
      Select Case ans 
        Case 6                                  'Yes 
         Set Targetcell = Range(j.Address) 
          Sheets("Log").Visible = True 
           Sheets("Log").Select 
            Range("B65536").End(xlUp).Offset(1, 0).Value = UserName 
            Range("C65536").End(xlUp).Offset(1, 0).Value = NameOfComputer 
            Range("D65536").End(xlUp).Offset(1, 0).Value = Date 
            Range("D65536").End(xlUp).NumberFormat = "dd mmm yyyy" 
            Range("E65536").End(xlUp).Offset(1, 0).Value = Time 
            Range("G65536").End(xlUp).Offset(1, 0).Value = "Procedure Error - DailyProd record exists for  " & Date 'add code here for logging etc 
           Case Else                               'No, Cancel or X 
          Exit Sub 
        End Select 
    Else                                        'we didn't find it 
        Set Targetcell = Range(Range("A65536").End(xlUp).Address).Offset(1, 0) 
    End If 
End With 
        
Call TransferData(Targetcell.Address)           'call the data transfer sub passing the target cell address 
    
End Sub

You will need to check that the TransferData sub is OK as far as which sheet names it uses.

cheers

Mark

 

[autigers]

Hiya Mark ....


Thanks for the tip ... What I am wondering is .... Is there a Public statement at workbook open that can run and do the

If Time>0.5 Then
Set sht1 = Sheets("DailyProd")
Else
Set sht1 = Sheets("DailyProd3") 
End If

Thanks

 

[Fat Cat]

I assume by using the Time, you are checking to see what time of day the workbook is opened and access the corresponding sheet. It will work if you put that code into a WorkBook_Open event.

However, what will hapen if someone opens the workbook at a later time to check or view it rather than enter data, this may automatically switch to the wrong sheet.

Could get around that (if it actually is a problem) by some sort of input box to check what they want to do.