Long VB If statement need shortened

autigers

autigers

Board Regular
Joined
Oct 9, 2005
Messages
139
Is there a better way to set this code up ?
Code: 
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
 
Sort by date Sort by votes
okay ... using same thread because my issue is similar to last ....
Only in this one, I have the code below which is supposed to look at a sheet in column A and if there is an entry for the current date to
1) Warn the user & Log the event
2) Update that row with the new information

If there is not a date found the just insert the new data.

I have gotten this to be able to work but it either inserts a new record even if it finds a date or doesn't insert a record at all ....

Code: 
Private Sub CommandButton1_Click()
'OK
'DATE: 10/26/05



For Each c In [DailyProd!$A$1:$A300]
    If c.Value = Me.Sdate.Text Then
MsgBox "There is a record already created for  " & Date
MsgBox "This event has been logged as Procedure error for  " & Environ("username")
    
    c.Offset(rowOffset:=0, columnOffset:=0) = Me.Sdate.Text
    c.Offset(rowOffset:=0, columnOffset:=1) = Me.Shift.Text
    c.Offset(rowOffset:=0, columnOffset:=2) = Me.Employee.Text
    c.Offset(rowOffset:=0, columnOffset:=3) = Me.Scheduled.Text
    c.Offset(rowOffset:=0, columnOffset:=4) = Me.Overtime.Text
    c.Offset(rowOffset:=0, columnOffset:=5) = Me.Flex.Text
    c.Offset(rowOffset:=0, columnOffset:=6) = Me.Other.Text
    c.Offset(rowOffset:=0, columnOffset:=7) = Me.Peto.Text
    c.Offset(rowOffset:=0, columnOffset:=8) = Me.Vacation.Text
    c.Offset(rowOffset:=0, columnOffset:=9) = Me.RestrictedDuty.Text
    c.Offset(rowOffset:=0, columnOffset:=10) = Me.STDWorkersComp.Text
    c.Offset(rowOffset:=0, columnOffset:=11) = Me.TotalEEs.Text
    c.Offset(rowOffset:=0, columnOffset:=14) = Me.UniversalMoves.Text
    c.Offset(rowOffset:=0, columnOffset:=15) = Me.UniversalUnits.Text
    c.Offset(rowOffset:=0, columnOffset:=17) = Me.OfflineMoves.Text
    c.Offset(rowOffset:=0, columnOffset:=18) = Me.OfflineUnits.Text
    c.Offset(rowOffset:=0, columnOffset:=20) = Me.ReplMoves.Text
    c.Offset(rowOffset:=0, columnOffset:=21) = Me.ReplUnits.Text
    c.Offset(rowOffset:=0, columnOffset:=23) = Me.DeckConsMoves.Text
    c.Offset(rowOffset:=0, columnOffset:=24) = Me.DeckConsUnits.Text
    c.Offset(rowOffset:=0, columnOffset:=26) = Me.MoveAllsMoves.Text
    c.Offset(rowOffset:=0, columnOffset:=27) = Me.MoveAllsUnits.Text
    c.Offset(rowOffset:=0, columnOffset:=29) = Me.PalletConsMoves.Text
    c.Offset(rowOffset:=0, columnOffset:=30) = Me.PalletConsUnits.Text
    c.Offset(rowOffset:=0, columnOffset:=32) = Me.ConsRunnerMoves.Text
    c.Offset(rowOffset:=0, columnOffset:=33) = Me.ConsRunnerUnits.Text
    c.Offset(rowOffset:=0, columnOffset:=35) = Me.BinPickMoves.Text
    c.Offset(rowOffset:=0, columnOffset:=36) = Me.BinPickUnits.Text
    c.Offset(rowOffset:=0, columnOffset:=38) = Me.UpackInductMoves.Text
    c.Offset(rowOffset:=0, columnOffset:=39) = Me.UpackInductUnits.Text
    c.Offset(rowOffset:=0, columnOffset:=41) = Me.ExceptionMoves.Text
    c.Offset(rowOffset:=0, columnOffset:=42) = Me.ExceptionUnits.Text
    c.Offset(rowOffset:=0, columnOffset:=44) = Me.DeckCartonMoves.Text
    c.Offset(rowOffset:=0, columnOffset:=45) = Me.DeckCartonUnits.Text
    c.Offset(rowOffset:=0, columnOffset:=47) = Me.PalletPutMoves.Text
    c.Offset(rowOffset:=0, columnOffset:=48) = Me.PalletPutUnits.Text
    c.Offset(rowOffset:=0, columnOffset:=50) = Me.PutRunnerMoves.Text
    c.Offset(rowOffset:=0, columnOffset:=51) = Me.PutRunnerUnits.Text
    c.Offset(rowOffset:=0, columnOffset:=53) = Me.HighbayPutMoves.Text
    c.Offset(rowOffset:=0, columnOffset:=55) = Me.HighbayPickMoves.Text
    c.Offset(rowOffset:=0, columnOffset:=56) = Me.HighbayPickUnits.Text
    c.Offset(rowOffset:=0, columnOffset:=57) = Me.HighbayReplMoves.Text
    c.Offset(rowOffset:=0, columnOffset:=58) = Me.HighbayReplUnits.Text
    c.Offset(rowOffset:=0, columnOffset:=61) = Me.HighbayReboxPacked.Text
    c.Offset(rowOffset:=0, columnOffset:=63) = Me.HighbayTimer.Text
Else
End If
Next
ActiveWorkbook.Sheets("DailyProd").Activate
    Range("A2").Select
Do
    If IsEmpty(ActiveCell) = False Then
        ActiveCell.Offset(1, 0).Select
End If
   Loop Until IsEmpty(ActiveCell) = True
   
    ActiveCell.Value = Sdate.Value
    ActiveCell.Offset(0, 1) = Shift.Value
    ActiveCell.Offset(0, 2) = Employee.Value
    ActiveCell.Offset(0, 3) = Scheduled.Value
    ActiveCell.Offset(0, 4) = Overtime.Value
    ActiveCell.Offset(0, 5) = Flex.Value
    ActiveCell.Offset(0, 6) = Other.Value
    ActiveCell.Offset(0, 7) = Peto.Value
    ActiveCell.Offset(0, 8) = Vacation.Value
    ActiveCell.Offset(0, 9) = RestrictedDuty.Value
    ActiveCell.Offset(0, 10) = STDWorkersComp.Value
    ActiveCell.Offset(0, 11) = TotalEEs.Value
    ActiveCell.Offset(0, 14) = UniversalMoves.Value
    ActiveCell.Offset(0, 15) = UniversalUnits.Value
    ActiveCell.Offset(0, 17) = OfflineMoves.Value
    ActiveCell.Offset(0, 18) = OfflineUnits.Value
    ActiveCell.Offset(0, 20) = ReplMoves.Value
    ActiveCell.Offset(0, 21) = ReplUnits.Value
    ActiveCell.Offset(0, 23) = DeckConsMoves.Value
    ActiveCell.Offset(0, 24) = DeckConsUnits.Value
    ActiveCell.Offset(0, 26) = MoveAllsMoves.Value
    ActiveCell.Offset(0, 27) = MoveAllsUnits.Value
    ActiveCell.Offset(0, 29) = PalletConsMoves.Value
    ActiveCell.Offset(0, 30) = PalletConsUnits.Value
    ActiveCell.Offset(0, 32) = ConsRunnerMoves.Value
    ActiveCell.Offset(0, 33) = ConsRunnerUnits.Value
    ActiveCell.Offset(0, 35) = BinPickMoves.Value
    ActiveCell.Offset(0, 36) = BinPickUnits.Value
    ActiveCell.Offset(0, 38) = UpackInductMoves.Value
    ActiveCell.Offset(0, 39) = UpackInductUnits.Value
    ActiveCell.Offset(0, 41) = ExceptionMoves.Value
    ActiveCell.Offset(0, 42) = ExceptionUnits.Value
    ActiveCell.Offset(0, 44) = DeckCartonMoves.Value
    ActiveCell.Offset(0, 45) = DeckCartonUnits.Value
    ActiveCell.Offset(0, 47) = PalletPutMoves.Value
    ActiveCell.Offset(0, 48) = PalletPutUnits.Value
    ActiveCell.Offset(0, 50) = PutRunnerMoves.Value
    ActiveCell.Offset(0, 51) = PutRunnerUnits.Value
    ActiveCell.Offset(0, 53) = HighbayPutMoves.Value
    ActiveCell.Offset(0, 55) = HighbayPickMoves.Value
    ActiveCell.Offset(0, 56) = HighbayPickUnits.Value
    ActiveCell.Offset(0, 57) = HighbayReplMoves.Value
    ActiveCell.Offset(0, 58) = HighbayReplUnits.Value
    ActiveCell.Offset(0, 61) = HighbayReboxPacked.Value
    ActiveCell.Offset(0, 63) = HighbayTimer.Value
    
    MsgBox "You must now complete shift end numbers. Carryover entry will now load"
DailyProd.Hide
DShiftCarryover.Show


End Sub
 
Upvote 0

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
Hi

My first thought would be to check the format of the date and the matching with the text box result. Depending on the formatting issues, you may find that there is a problem matching.

Also, instead of doing the loop on all values, how about using the find function to see if there is a match. Lot faster.


Tony
 
Upvote 0
I had a similar idea to Tony, do a find first and then transfer data;

Maybe something like (untested);

Code: 
Private Sub CommandButton1_Click()

Dim what As Variant
Dim sht1 As Worksheet

what = Me.Sdate.Text                            '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 c = .Find(what, LookIn:=xlValues)
    If Not c 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(c.Address)
                '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

Sub TransferData(ByVal Target As String)

Set sht1 = Sheets("DailyProd")

    sht1.Range(Target).Offset(0, 0) = Sdate.Value
    sht1.Range(Target).Offset(0, 1) = Shift.Value
    sht1.Range(Target).Offset(0, 2) = Employee.Value
    sht1.Range(Target).Offset(0, 3) = Scheduled.Value
    sht1.Range(Target).Offset(0, 4) = Overtime.Value
    sht1.Range(Target).Offset(0, 5) = Flex.Value
    sht1.Range(Target).Offset(0, 6) = Other.Value
    sht1.Range(Target).Offset(0, 7) = Peto.Value
    sht1.Range(Target).Offset(0, 8) = Vacation.Value
    sht1.Range(Target).Offset(0, 9) = RestrictedDuty.Value
    sht1.Range(Target).Offset(0, 10) = STDWorkersComp.Value
    sht1.Range(Target).Offset(0, 11) = TotalEEs.Value
    sht1.Range(Target).Offset(0, 14) = UniversalMoves.Value
    sht1.Range(Target).Offset(0, 15) = UniversalUnits.Value
    sht1.Range(Target).Offset(0, 17) = OfflineMoves.Value
    sht1.Range(Target).Offset(0, 18) = OfflineUnits.Value
    sht1.Range(Target).Offset(0, 20) = ReplMoves.Value
    sht1.Range(Target).Offset(0, 21) = ReplUnits.Value
    sht1.Range(Target).Offset(0, 23) = DeckConsMoves.Value
    sht1.Range(Target).Offset(0, 24) = DeckConsUnits.Value
    sht1.Range(Target).Offset(0, 26) = MoveAllsMoves.Value
    sht1.Range(Target).Offset(0, 27) = MoveAllsUnits.Value
    sht1.Range(Target).Offset(0, 29) = PalletConsMoves.Value
    sht1.Range(Target).Offset(0, 30) = PalletConsUnits.Value
    sht1.Range(Target).Offset(0, 32) = ConsRunnerMoves.Value
    sht1.Range(Target).Offset(0, 33) = ConsRunnerUnits.Value
    sht1.Range(Target).Offset(0, 35) = BinPickMoves.Value
    sht1.Range(Target).Offset(0, 36) = BinPickUnits.Value
    sht1.Range(Target).Offset(0, 38) = UpackInductMoves.Value
    sht1.Range(Target).Offset(0, 39) = UpackInductUnits.Value
    sht1.Range(Target).Offset(0, 41) = ExceptionMoves.Value
    sht1.Range(Target).Offset(0, 42) = ExceptionUnits.Value
    sht1.Range(Target).Offset(0, 44) = DeckCartonMoves.Value
    sht1.Range(Target).Offset(0, 45) = DeckCartonUnits.Value
    sht1.Range(Target).Offset(0, 47) = PalletPutMoves.Value
    sht1.Range(Target).Offset(0, 48) = PalletPutUnits.Value
    sht1.Range(Target).Offset(0, 50) = PutRunnerMoves.Value
    sht1.Range(Target).Offset(0, 51) = PutRunnerUnits.Value
    sht1.Range(Target).Offset(0, 53) = HighbayPutMoves.Value
    sht1.Range(Target).Offset(0, 55) = HighbayPickMoves.Value
    sht1.Range(Target).Offset(0, 56) = HighbayPickUnits.Value
    sht1.Range(Target).Offset(0, 57) = HighbayReplMoves.Value
    sht1.Range(Target).Offset(0, 58) = HighbayReplUnits.Value
    sht1.Range(Target).Offset(0, 61) = HighbayReboxPacked.Value
    sht1.Range(Target).Offset(0, 63) = HighbayTimer.Value

End Sub
 
Upvote 0
excellent code work ....
very easy to understand from the comments ....ty
I have tested but can't figure out why it only puts data in starting in row 15.
If the date is above row 15 then it puts a new record starting there ....
 
Upvote 0
Hi

The address for the next record is being determined from the current sheet rather than trying to find the next blank row on the output sheet (Dailyprod)

Try changing
Set TargetCell = Range(Range("A65536").End(xlUp).Address).Offset(1, 0)
to
Set TargetCell = sheets("Dailyprod").Range(Range("A65536").End(xlUp).Address).Offset(1, 0)


Tony
 
Upvote 0
okay ... replaced ....
I tested the find and it is not seeing the date ...
I tried setting formats with no luck on finding the date ... I don't understand ....
 
Upvote 0
Hi

Have you stepped through the code to make sure it is finding the date (when one exists)?

How is the date set up on your source sheet? Is it a value formatted as a date (normal excel process). If so, then putting in the "same" format in the text box won't work as this is text.

Assuming the source date is in the normal process, formatted as dd/mm/yyyy then change
what = Me.Sdate.Text
to
what = datevalue(Me.Sdate.Text)

and see if it then finds the date.


Tony
 
Upvote 0
Does this help;

The variable "what" is initially declared as type Variant, so when it gets assigned with Me.Sdate.Text it becomes a String variable.

This might then cause problems when comparing with Dates.

Does this help at all;


Code: 
what = DateValue(Me.Sdate.Text)

you can add a msgbox to the first line of the TransferData sub to see what address is being passed
Code: 
MsgBox (Target)

Sorry Tony, didn't see you post until after I had hit the submit button
 
Upvote 0
Heres what Iam testing .... Now I get no message at all ...
Code: 
Private Sub CommandButton1_Click()

Dim what As Variant
Dim sht1 As Worksheet

what = DateValue(Me.Sdate.Text)                            '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 c = .Find(what, LookIn:=xlValues)
    If Not c 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 ?")
       Else
        MsgBox "Not Found"
        End If
End With
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Solved
VBA to do certain tasks on file opening
Replies
6
Views
165
jdhfch
J
L
  • Question Question
VBA code not working on Mac
Replies
7
Views
1K
Jim Gordon
J
crook_101
  • Solved
VB to loop
Replies
5
Views
337
myall_blues
myall_blues
A
  • Question Question
Autofilter code based on username
Replies
1
Views
376
aabrazil1
A
S
  • Solved
Need to have Worksheet_Change event include value from another column using structured reference
Replies
4
Views
527
Alex Blakenburg
A

Forum statistics

Threads
1,224,883
Messages
6,181,551
Members
453,052
Latest member
ezzat

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