Consulting

Results 1 to 3 of 3

Thread: script help

  1. #1
    VBAX Expert
    Joined
    Apr 2007
    Location
    Orlando, FL
    Posts
    751
    Location

    script help

    i have this script
    [vba]Private Sub CmdPrintSave_Click()
    Dim mpLookup As String
    Dim mpRange As Range
    Dim mpCell As Range
    Dim mpFirst As String
    Dim mpFind As Long

    mpLookup = EditPrintFrm.TxtOrdNum.Text
    On Error Resume Next
    mpFind = Application.Match(mpLookup, Worksheets("Packing Slip Pim").Columns(1), 0)
    On Error GoTo 0
    If mpFind = 0 Then

    InsertEm
    Else

    If MsgBox("A Match has been found do you wish do delete previous one(s)?", _
    vbYesNo) = vbYes Then

    With Worksheets("Packing Slip Pim").Columns(1)

    Set mpCell = .Find(mpLookup)
    Set mpRange = mpCell
    mpFirst = mpRange.Address

    Do

    Set mpCell = .FindNext(mpCell)
    If Not mpCell Is Nothing Then

    Set mpRange = Union(mpRange, mpCell)
    End If
    Loop Until mpCell Is Nothing Or mpCell.Address = mpFirst
    End With
    InsertEm
    If Not mpRange Is Nothing Then mpRange.EntireRow.Delete
    End If
    End If
    Unload EditPrintFrm
    End Sub
    Public Sub InsertEm()
    Dim RowNext As Integer, i As Long, j As Long
    'last row of data
    RowNext = Worksheets("Packing Slip Pim").Cells(Rows.Count, 1).End(xlUp).Row
    'Count number of items
    j = 0
    For i = 1 To 54
    If EditPrintFrm.Controls("CmbBoxDesc" & i).Text <> "" Then
    j = j + 1
    Else
    Exit For
    End If
    Next

    For i = 1 To j
    With Worksheets("Packing Slip Pim")
    .Cells(RowNext + i, 1) = UCase(EditPrintFrm.TxtOrdNum.Value)
    .Cells(RowNext + i, 2) = EditPrintFrm.TxtShipDate.Text
    .Cells(RowNext + i, 3) = EditPrintFrm.LblShipVia.Caption
    .Cells(RowNext + i, 4) = UCase(EditPrintFrm.Controls("TxtTrack" & i).Value)
    .Cells(RowNext + i, 5) = EditPrintFrm.Controls("TxtSN" & i).Value
    .Cells(RowNext + i, 6) = EditPrintFrm.Controls("CmbBoxDesc" & i).Value
    .Cells(RowNext + i, 7) = EditPrintFrm.Controls("TxtQua" & i).Value
    .Cells(RowNext + i, 8) = EditPrintFrm.CmbBoxProject.Value
    .Cells(RowNext + i, 9) = EditPrintFrm.LblRacf.Caption
    .Cells(RowNext + i, 10) = EditPrintFrm.CmbBoxClientName.Value
    .Cells(RowNext + i, 11) = EditPrintFrm.CmbBoxLocation.Value
    .Cells(RowNext + i, 12) = EditPrintFrm.TxtShippedBy.Text
    .Cells(RowNext + i, 13) = EditPrintFrm.TxtComments.Text
    If EditPrintFrm.ChkBoxComments = True Then .Cells(RowNext + i, 14) = "YES"
    If EditPrintFrm.ChkBoxNewHire = True Then .Cells(RowNext + i, 15) = "YES"
    End With

    Next

    End Sub[/vba]

    This works great but I just noticed that I think "mpFind" doesn't work with numbers. can anyone help.
    Last edited by Emoncada; 01-04-2008 at 12:54 PM.

  2. #2
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    What does that final sentence mean?
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  3. #3
    VBAX Expert
    Joined
    Apr 2007
    Location
    Orlando, FL
    Posts
    751
    Location
    I believe that basically goes to the nextrow. The problem is either in this or in this module. This calls the Data back to the form.

    [VBA]Sub GButton_Click()
    Dim rngSel As Range
    Dim rngLoop As Range
    Dim intCounter As Integer

    Set rngSel = Selection

    'error trapping to determine if a valid row was selected
    If rngSel.Worksheet.Name <> "Packing Slip Pim" Then
    MsgBox "Please select an Order # cell on the 'Packing Slip Pim' worksheet"
    Exit Sub
    ElseIf rngSel.Cells.Count <> 1 Then
    MsgBox "Only select one cell in Column A."
    Exit Sub
    ElseIf rngSel.Column <> 1 Then
    MsgBox "The selection is not in Column A. Please select a cell in Column A and try again."
    Exit Sub
    ElseIf rngSel = "" Then
    MsgBox "The cell you selected does not have an order number, please choose a cell with an order number"
    Exit Sub
    ElseIf rngSel.Row <= 1 Then
    MsgBox "The cell you selected is in the title, not in the data. Please select an Order Number in the data and try again"
    Exit Sub
    End If

    Load EditPrintFrm
    Set rngLoop = Range("A2")
    intCounter = 1
    While rngLoop <> ""
    If rngLoop = rngSel Then
    With EditPrintFrm
    .TxtOrdNum.Text = rngLoop
    .TxtShipDate.Text = rngLoop.Offset(0, 1)
    .LblShipVia.Caption = rngLoop.Offset(0, 2)

    If .LblShipVia.Caption = "FEDEX" Then
    .ImageFedEx.Visible = True
    End If
    If .LblShipVia.Caption = "UPGF" Then
    .ImageUPS.Visible = True
    End If
    If .LblShipVia.Caption = "Pick Up" Then
    .ImagePickUp.Visible = True
    End If

    .Controls("TxtTrack" & intCounter).Value = rngLoop.Offset(0, 3)
    .Controls("TxtSN" & intCounter).Value = rngLoop.Offset(0, 4)
    .Controls("CmbBoxDesc" & intCounter).Value = rngLoop.Offset(0, 5)
    .Controls("TxtQua" & intCounter).Value = rngLoop.Offset(0, 6)
    If .CmbBoxProject.Value = "MORTGAGE" Then
    .CmbBoxProject.Value = rngLoop.Offset(0, 7)
    .CmdMortgage1320.Visible = True
    .cmdMortgage17in.Visible = True
    .CmdMortgage2015.Visible = True
    .CmdMortgage3600.Visible = True
    .CmdMortgage4250.Visible = True
    .CmdMortgage4700.Visible = True
    .CmdMortgage7600.Visible = True
    .CmdMortgage7700.Visible = True
    .CmdMortgage8430.Visible = True
    .CmdMortgage8230.Visible = True
    .Cmd17IN.Visible = False
    .CmdCheckMateBundle.Visible = False
    .CmdDC7600.Visible = False
    .CmdDC7700.Visible = False
    .CmdNC8230.Visible = False
    .CmdNC8430.Visible = False
    Else
    .CmbBoxProject.Value = rngLoop.Offset(0, 7)
    End If
    .LblRacf.Caption = rngLoop.Offset(0, 8)
    .CmbBoxClientName.Value = rngLoop.Offset(0, 9)
    .CmbBoxLocation.Value = rngLoop.Offset(0, 10)
    .TxtShippedBy.Value = rngLoop.Offset(0, 11)
    .TxtComments.Value = rngLoop.Offset(0, 12)
    If rngLoop.Offset(0, 13) = "YES" Then
    .ChkBoxComments = True
    Else
    .ChkBoxComments = False
    End If
    If rngLoop.Offset(0, 14) = "YES" Then
    .ChkBoxNewHire = True
    Else
    .ChkBoxNewHire = False
    End If
    End With

    intCounter = intCounter + 1
    End If
    Set rngLoop = rngLoop.Offset(1, 0)
    Wend
    EditPrintFrm.Show
    End Sub[/VBA]

    Hope that helps

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •