Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations wOOdy-Soft on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Streamlining code 2

Status
Not open for further replies.
optjco

optjco

IS-IT--Management
Apr 13, 2004
185
GB
Hi everyone,
I have inherited a spreadsheet that is pretty much controlled via VBA, it contains several forms, on one of the forms there is code so that if certain people are using it then they can do more than the ordinary user however it is quite long and cumbersome to administer and i was wondering if someone could perhaps help to give me some ideas on how to streamline it. The code is shown below

Code: 
Private Sub cmdUpDate_Click()
Dim Prow, Pcol, Mcol, Ncol, Qcol, Tcell As Long

Prow = Range("L1").Value        'These Values are assigned from
Pcol = Range("M1").Value        'the worksheet code realting to the
Mcol = Range("N1").Value        ' appropiate command button and then
Qcol = Range("O1").Value        'uses the value from the textboxes and labels
Ncol = Range("P1").Value        'to insert into the spreadsheet
Tcell = Range("Q1").Value
Sheets("FlatBeds").Cells(Prow, Pcol).Value = txtCust.Value
Sheets("FlatBeds").Cells(Prow, Mcol).Value = txtMB.Value & txtDash.Value & TxtItem.Value
Sheets("FlatBeds").Cells(Prow, Qcol).Value = txtQty.Value
Sheets("FlatBeds").Cells(Prow, Ncol).Value = lblUserName.Caption

If (txtCust.Value = "") Or (txtMB.Value = "") Or (TxtItem.Value = "") Or (txtQty.Value = "") Then
    Sheets("FlatBeds").Cells(Prow, Pcol).Value = ""
    Sheets("FlatBeds").Cells(Prow, Mcol).Value = ""
    Sheets("FlatBeds").Cells(Prow, Qcol).Value = ""
    Sheets("FlatBeds").Cells(Prow, Ncol).Value = ""
    txtCust.Value = Clear
    txtMB.Value = Clear
    txtDash.Value = Clear
    TxtItem.Value = Clear
    txtQty.Value = Clear
    lblUserName.Caption = Clear
    txtCust.SetFocus
    MsgBox "WARNING" & vbCrLf & vbCrLf & "ALL FIELDS MUST CONTAIN DATA", 48, "Missing Data"
    
    Else
    If (Sheets("FlatBeds").Cells(Prow, Qcol).Value > Tcell) _
    And (Sheets("FlatBeds").Cells(Prow, Ncol).Value = "SSams") Then    'If this argument is true then the
    Sheets("FlatBeds").Cells(Prow, Pcol).Value = txtCust.Value           ' values are assigned, otherwise the
    Sheets("FlatBeds").Cells(Prow, Mcol).Value = txtMB.Value & txtDash.Value & TxtItem.Value             'Message box is invoked
    Sheets("FlatBeds").Cells(Prow, Qcol).Value = txtQty.Value
    Sheets("FlatBeds").Cells(Prow, Ncol).Value = lblUserName.Caption
        
    Else
   If (Sheets("FlatBeds").Cells(Prow, Qcol).Value > Tcell) _
        And (Sheets("FlatBeds").Cells(Prow, Ncol).Value = "SFaulkner") Then    'If this argument is true then the
        Sheets("FlatBeds").Cells(Prow, Pcol).Value = txtCust.Value           ' values are assigned, otherwise the
        Sheets("FlatBeds").Cells(Prow, Mcol).Value = txtMB.Value & txtDash.Value & TxtItem.Value             'Message box is invoked
        Sheets("FlatBeds").Cells(Prow, Qcol).Value = txtQty.Value
        Sheets("FlatBeds").Cells(Prow, Ncol).Value = lblUserName.Caption
        Else
        If (Sheets("FlatBeds").Cells(Prow, Qcol).Value > Tcell) _
        And (Sheets("FlatBeds").Cells(Prow, Ncol).Value = "POliver") Then      'If this argument is true then the
        Sheets("FlatBeds").Cells(Prow, Pcol).Value = txtCust.Value           ' values are assigned, otherwise the
        Sheets("FlatBeds").Cells(Prow, Mcol).Value = txtMB.Value & txtDash.Value & TxtItem.Value             'Message box is invoked
        Sheets("FlatBeds").Cells(Prow, Qcol).Value = txtQty.Value
        Sheets("FlatBeds").Cells(Prow, Ncol).Value = lblUserName.Caption
            Else
            If (Sheets("FlatBeds").Cells(Prow, Qcol).Value <= Tcell) Then    'If this argument is true then the
            Sheets("FlatBeds").Cells(Prow, Pcol).Value = txtCust.Value       ' values are assigned, otherwise the
            Sheets("FlatBeds").Cells(Prow, Mcol).Value = txtMB.Value & txtDash.Value & TxtItem.Value         'Message box is invoked And when the OK
            Sheets("FlatBeds").Cells(Prow, Qcol).Value = txtQty.Value        'button is pressed, the values are cleared
            Sheets("FlatBeds").Cells(Prow, Ncol).Value = lblUserName.Caption
                Else
                If (Sheets("FlatBeds").Cells(Prow, Qcol).Value > Tcell) _
                And (Sheets("FlatBeds").Cells(Prow, Ncol).Value = "") Then
                Sheets("FlatBeds").Cells(Prow, Pcol).Value = ""          'the cells and the form boxes are
                Sheets("FlatBeds").Cells(Prow, Mcol).Value = ""          'cleared and the focus is reset to
                Sheets("FlatBeds").Cells(Prow, Qcol).Value = ""          'the Customer text box
                Sheets("FlatBeds").Cells(Prow, Ncol).Value = ""
                txtCust.Value = Clear
                txtMB.Value = Clear
                TxtItem.Value = Clear
                txtDash.Value = Clear
                txtQty.Value = Clear
                lblUserName.Caption = Clear
                txtCust.SetFocus
    
                    Else
                    MsgBox "WARNING" & vbCrLf & vbCrLf & _
                    "This orders Qty exceeds the available Qty, your Order wiil not be placed" & vbCrLf & vbCrLf & _
                    "Only an Authorised User may enter this order", 48, "Machine Overload"
                    Sheets("FlatBeds").Cells(Prow, Pcol).Value = ""          'If none of the above are True then
                    Sheets("FlatBeds").Cells(Prow, Mcol).Value = ""          'the cells and the form boxes are
                    Sheets("FlatBeds").Cells(Prow, Qcol).Value = ""          'cleared and the focus is reset to
                    Sheets("FlatBeds").Cells(Prow, Ncol).Value = ""          'the Customer text box
                    txtCust.Value = Clear
                    txtMB.Value = Clear
                    TxtItem.Value = Clear
                    txtDash.Value = Clear
                    txtQty.Value = Clear
                    lblUserName.Caption = Clear
                    txtCust.SetFocus
                    End
                    End If
                End If
            End If
        End If
    End If
    End If
End Sub

Any help would be appreciated bearing in mind my limited knowledge

Regards

Olly
 
Sort by date Sort by votes
SkipVought has covered a number of methods in his FAQ :

faq707-4105

It's a great starting point!



Cheers,
Dave

Probably the only Test Analyst on Tek-Tips

animadverto vos in Abyssus!

Take a look at Forum1393 & sign up if you'd like
 
Upvote 0 Downvote
How 'bout this???
Code: 
Private Sub cmdUpDate_Click()
    Dim Prow, Pcol, Mcol, Ncol, Qcol, Tcell As Long
    
    Prow = Range("L1").Value        'These Values are assigned from
    Pcol = Range("M1").Value        'the worksheet code realting to the
    Mcol = Range("N1").Value        ' appropiate command button and then
    Qcol = Range("O1").Value        'uses the value from the textboxes and labels
    Ncol = Range("P1").Value        'to insert into the spreadsheet
    Tcell = Range("Q1").Value
    With Sheets("FlatBeds")
        GoSub LoadObjects
        If (txtCust.Value = "") Or (txtMB.Value = "") Or (TxtItem.Value = "") Or (txtQty.Value = "") Then
            GoSub ClearObjects
            MsgBox "WARNING" & vbCrLf & vbCrLf & "ALL FIELDS MUST CONTAIN DATA", 48, "Missing Data"
            
        Else
            Select Case (.Cells(Prow, Qcol).Value)
                Case Is > Tcell
                    Select Case (.Cells(Prow, Ncol).Value)
                        Case "SSams", "SFaulkner", "POliver"
                            GoSub LoadObjects
                        Case ""
                            GoSub ClearObjects
                        Case Else
                            GoSub ClearObjects
                            MsgBox "WARNING" & vbCrLf & vbCrLf & _
                            "This orders Qty exceeds the available Qty, your Order wiil not be placed" & vbCrLf & vbCrLf & _
                            "Only an Authorised User may enter this order", 48, "Machine Overload"
                    End Select
                Case Is <= Tcell
                    GoSub LoadObjects
            End Select
        End If
    End With
    Exit Sub
LoadObjects:
    .Cells(Prow, Pcol).Value = txtCust.Value
    .Cells(Prow, Mcol).Value = txtMB.Value & txtDash.Value & TxtItem.Value
    .Cells(Prow, Qcol).Value = txtQty.Value
    .Cells(Prow, Ncol).Value = lblUserName.Caption
    Return
ClearObjects:
    .Cells(Prow, Pcol).Value = ""          'If none of the above are True then
    .Cells(Prow, Mcol).Value = ""          'the cells and the form boxes are
    .Cells(Prow, Qcol).Value = ""          'cleared and the focus is reset to
    .Cells(Prow, Ncol).Value = ""          'the Customer text box
    txtCust.Value = Clear
    txtMB.Value = Clear
    TxtItem.Value = Clear
    txtDash.Value = Clear
    txtQty.Value = Clear
    lblUserName.Caption = Clear
    txtCust.SetFocus
    Return
End Sub

Skip,

[glasses] [red]Be advised:[/red]When Viscounts were guillotined just as they were disclosing where their jewels were hidden, it shows to go that you should...
Never hatchet your Counts before they chicken! [tongue]
 
Upvote 0 Downvote
Skip,
thanks for the reply, I tried your code but got this error message

Invalid or Unqualified reference

at the following lines

Code: 
LoadObjects:
    [COLOR=red].Cells(Prow, Pcol).Value = txtCust.Value
    .Cells(Prow, Mcol).Value = txtMB.Value & txtDash.Value & TxtItem.Value
    .Cells(Prow, Qcol).Value = txtQty.Value
    .Cells(Prow, Ncol).Value = lblUserName.Caption
    Return[/color]

However I just removed the periods and now it seems to work fine, should this be OK ?


Regards

Olly
 
Upvote 0 Downvote
Sorry,

the subroutines need a sheet object
Code: 
LoadObjects:
With Sheets("FlatBeds")
    .Cells(Prow, Pcol).Value = txtCust.Value
    .Cells(Prow, Mcol).Value = txtMB.Value & txtDash.Value & TxtItem.Value
    .Cells(Prow, Qcol).Value = txtQty.Value
    .Cells(Prow, Ncol).Value = lblUserName.Caption
    Return
End With
ClearObjects:
With Sheets("FlatBeds")
    .Cells(Prow, Pcol).Value = ""          'If none of the above are True then
    .Cells(Prow, Mcol).Value = ""          'the cells and the form boxes are
    .Cells(Prow, Qcol).Value = ""          'cleared and the focus is reset to
    .Cells(Prow, Ncol).Value = ""          'the Customer text box
    txtCust.Value = Clear
    txtMB.Value = Clear
    TxtItem.Value = Clear
    txtDash.Value = Clear
    txtQty.Value = Clear
    lblUserName.Caption = Clear
    txtCust.SetFocus
    Return
End With

Skip,

[glasses] [red]Be advised:[/red]When Viscounts were guillotined just as they were disclosing where their jewels were hidden, it shows to go that you should...
Never hatchet your Counts before they chicken! [tongue]
 
Upvote 0 Downvote
LoadObjects:
With Sheets("FlatBeds")
.Cells(Prow, Pcol).Value = txtCust.Value
...
End With
Return
ClearObjects:
With Sheets("FlatBeds")
...
End With
Return

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244
 
Upvote 0 Downvote
Skip/PHV
Thank you both for your help, code works great now

Regards

Olly
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

Kymenglish
  • Locked
  • Question
Automated data entry code in MS Excel VB - Edge code how to hit enter to remove popups
Replies
3
Views
580
strongm
strongm
morechocolate
  • Locked
  • Question
run-tune error 3704 operation is not allowed when the object is codes: I don't think so.
Replies
7
Views
1K
morechocolate
morechocolate
MattGreer
  • Locked
  • Question
VBA Code Deleting a Column instead of Rows...
Replies
6
Views
336
SkipVought
S
MattGreer
  • Locked
  • Question
Application Lockups During Code Execution 4
Replies
9
Views
448
MattGreer
MattGreer
EliseFreedman
  • Locked
  • Question
Running Code for every value in a column 1
Replies
4
Views
259
Andrzejek
Andrzejek

Part and Inventory Search

Sponsor

Back
Top