PDA

View Full Version : script help



Emoncada
01-04-2008, 11:42 AM
i have this script
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

This works great but I just noticed that I think "mpFind" doesn't work with numbers. can anyone help.

Bob Phillips
01-04-2008, 12:46 PM
What does that final sentence mean?

Emoncada
01-04-2008, 12:57 PM
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.

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

Hope that helps