close

Privacy guaranteed - Your email is not shared with anyone.

Excel VBA / Macro Programming Help!

Discussion in 'Tech Talk' started by Fernman, Jul 9, 2007.

  1. Fernman

    Fernman Zombie Jeebus! CLM

    Messages:
    1,414
    Likes Received:
    0
    Joined:
    Feb 14, 2005
    Location:
    Virginia
    Any other GTer's write VBA code in Excel? I am working on a program for my FFL for his BATF Bound Book Entries, but am having trouble with the search/edit functions. Anyone offer any help? I'll be glad to post code, etc.
     
  2. elderboy02

    elderboy02 Cincy Glocker

    Messages:
    141
    Likes Received:
    0
    Joined:
    Feb 11, 2007
    Location:
    Cincinnati, OH
    I have written bookoo VBA code in Word and Access, but not excel. Post it up and I will try.
     

  3. Fernman

    Fernman Zombie Jeebus! CLM

    Messages:
    1,414
    Likes Received:
    0
    Joined:
    Feb 14, 2005
    Location:
    Virginia
    Private Sub cmdCancel_Click()
    Unload Me
    End Sub



    Private Sub cmdClear_Click()
    Me.manufacturer.Value = ""
    Me.model.Value = ""
    Me.serial.Value = ""
    Me.actiontype.Value = ""
    Me.caliber.Value = ""
    Me.date_rec.Value = ""
    Me.rec_from.Value = ""
    Me.date_sold.Value = ""
    Me.sold_to.Value = ""
    Me.reference.Value = ""
    Me.nuckols.SetFocus
    End Sub


    Private Sub cmdNuckols_Click()
    Dim iRow As Long
    Dim ws As Worksheet
    Set ws = Worksheets("CHRIS")

    Application.ScreenUpdating = False
    Dim NuckolsNumber As String, NuckolsCell As Range
    NuckolsNumber = InputBox("Please Enter Nuckols Number")

    'To end sub if "cancel" was pressed, sourced from _
    http://www.excelforum.com/showthread.php?t=466059&highlight=vbcancel+input & http://vb.mvps.org/tips/varptr.asp
    If StrPtr(NuckolsNumber) = 0 Then
    MsgBox "No Nuckols Number Entered. Terminating Program"
    GoTo ExitSub
    End If

    'to identify the row/cell that the Nuckols Number is on
    Set NuckolsCell = Sheet1.Range("a:a").Find(What:=NuckolsNumber _
    , LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext)


    'checking that a match was found
    If NuckolsCell Is Nothing Then GoTo InfoMsg
    With NuckolsCell.Offset(0, 2)
    .Copy .Offset(0, 1)
    .ClearContents
    End With


    manufacturer.Text = NuckolsCell.Cells([1], [2]).Value
    model.Text = NuckolsCell.Cells([1], [3]).Value
    serial.Text = NuckolsCell.Cells([1], [4]).Value
    actiontype.Text = NuckolsCell.Cells([1], [5]).Value
    caliber.Text = NuckolsCell.Cells([1], [6]).Value
    date_rec.Text = NuckolsCell.Cells([1], [7]).Value
    rec_from.Text = NuckolsCell.Cells([1], [8]).Value
    date_sold.Text = NuckolsCell.Cells([1], [9]).Value
    sold_to.Text = NuckolsCell.Cells([1], [10]).Value
    reference.Text = NuckolsCell.Cells([1], [11]).Value

    ExitSub:
    Set NuckolsCell = Nothing
    Application.ScreenUpdating = True
    Exit Sub

    InfoMsg:
    MsgBox "Nuckols Number (" & NuckolsNumber & ") not found, please check & reenter.", vbOKOnly, "NUCKOLS NUMBER NOT FOUND"
    End Sub
    Private Sub cmdUpdate_Click()
    Dim iRow As Long
    Dim ws As Worksheet
    Set ws = Worksheets("CHRIS")

    If Trim(Me.manufacturer.Value) = "" Then
    Me.manufacturer.SetFocus
    MsgBox "Please enter a manufacturer"
    Exit Sub
    End If

    If Trim(Me.model.Value) = "" Then
    Me.model.SetFocus
    MsgBox "Please enter a model"
    Exit Sub
    End If

    If Trim(Me.serial.Value) = "" Then
    Me.serial.SetFocus
    MsgBox "Please enter a serial number"
    Exit Sub
    End If

    If Trim(Me.actiontype.Value) = "" Then
    Me.actiontype.SetFocus
    MsgBox "Please enter an action type"
    Exit Sub
    End If

    If Trim(Me.caliber.Value) = "" Then
    Me.caliber.SetFocus
    MsgBox "Please enter a caliber or gauge"
    Exit Sub
    End If

    If Trim(Me.date_rec.Value) = "" Then
    Me.date_rec.SetFocus
    MsgBox "Please enter the Date Recieved"
    Exit Sub
    End If

    If Trim(Me.rec_from.Value) = "" Then
    Me.rec_from.SetFocus
    MsgBox "Please enter a Recieved From Address"
    Exit Sub
    End If

    ws.Cells(iRow, 2).Value = Me.manufacturer.Value
    ws.Cells(iRow, 3).Value = Me.model.Value
    ws.Cells(iRow, 4).Value = Me.serial.Value
    ws.Cells(iRow, 5).Value = Me.actiontype.Value
    ws.Cells(iRow, 6).Value = Me.caliber.Value
    ws.Cells(iRow, 7).Value = Me.date_rec.Value
    ws.Cells(iRow, 8).Value = Me.rec_from.Value
    ws.Cells(iRow, 9).Value = Me.date_sold.Value
    ws.Cells(iRow, 10).Value = Me.sold_to.Value
    ws.Cells(iRow, 11).Value = Me.reference.Value



    End Sub





    Private Sub cmdSubmit_Click()
    Dim iRow As Long
    Dim ws As Worksheet
    Set ws = Worksheets("CHRIS")


    iRow = ws.Cells(Rows.Count, 2) _
    .End(xlUp).Offset(1, 0).Row

    If Trim(Me.manufacturer.Value) = "" Then
    Me.manufacturer.SetFocus
    MsgBox "Please enter a manufacturer"
    Exit Sub
    End If

    If Trim(Me.model.Value) = "" Then
    Me.model.SetFocus
    MsgBox "Please enter a model"
    Exit Sub
    End If

    If Trim(Me.serial.Value) = "" Then
    Me.serial.SetFocus
    MsgBox "Please enter a serial number"
    Exit Sub
    End If

    If Trim(Me.actiontype.Value) = "" Then
    Me.actiontype.SetFocus
    MsgBox "Please enter an action type"
    Exit Sub
    End If

    If Trim(Me.caliber.Value) = "" Then
    Me.caliber.SetFocus
    MsgBox "Please enter a caliber or gauge"
    Exit Sub
    End If

    If Trim(Me.date_rec.Value) = "" Then
    Me.date_rec.SetFocus
    MsgBox "Please enter the Date Recieved"
    Exit Sub
    End If

    If Trim(Me.rec_from.Value) = "" Then
    Me.rec_from.SetFocus
    MsgBox "Please enter a Recieved From Address"
    Exit Sub
    End If


    ws.Cells(iRow, 2).Value = Me.manufacturer.Value
    ws.Cells(iRow, 3).Value = Me.model.Value
    ws.Cells(iRow, 4).Value = Me.serial.Value
    ws.Cells(iRow, 5).Value = Me.actiontype.Value
    ws.Cells(iRow, 6).Value = Me.caliber.Value
    ws.Cells(iRow, 7).Value = Me.date_rec.Value
    ws.Cells(iRow, 8).Value = Me.rec_from.Value
    ws.Cells(iRow, 9).Value = Me.date_sold.Value
    ws.Cells(iRow, 10).Value = Me.sold_to.Value
    ws.Cells(iRow, 11).Value = Me.reference.Value



    Me.manufacturer.Value = ""
    Me.model.Value = ""
    Me.serial.Value = ""
    Me.actiontype.Value = ""
    Me.caliber.Value = ""
    Me.date_rec.Value = ""
    Me.rec_from.Value = ""
    Me.date_sold.Value = ""
    Me.sold_to.Value = ""
    Me.reference.Value = ""
    Me.manufacturer.SetFocus
     
  4. Fernman

    Fernman Zombie Jeebus! CLM

    Messages:
    1,414
    Likes Received:
    0
    Joined:
    Feb 14, 2005
    Location:
    Virginia
    I got the search/display working. All I need is the cmdNuckols button to UPDATE the entry, not create a new one... HALP!
     
  5. elderboy02

    elderboy02 Cincy Glocker

    Messages:
    141
    Likes Received:
    0
    Joined:
    Feb 11, 2007
    Location:
    Cincinnati, OH
    Well, I couldn't figure it out, and neither could my co-worker. Sorry. It is hard to do without the actual file, and we don't expect you to post it. Good luck. Anyone else think they can help?
     
  6. Fernman

    Fernman Zombie Jeebus! CLM

    Messages:
    1,414
    Likes Received:
    0
    Joined:
    Feb 14, 2005
    Location:
    Virginia
    I can email the file :)
     
  7. WhatYouWant

    WhatYouWant Duh!

    Messages:
    89
    Likes Received:
    0
    Joined:
    Feb 28, 2005
    Location:
    Land O' Sea
    This seems to be that you should write it in Access. Access sucks but it is better than excel for your task.
     
  8. elderboy02

    elderboy02 Cincy Glocker

    Messages:
    141
    Likes Received:
    0
    Joined:
    Feb 11, 2007
    Location:
    Cincinnati, OH
    If you want to you can. It is elderboy02@hotmail.com It will give me and my fellow computer programming buddy something fun to do.
     
  9. JVMHGF

    JVMHGF NRA Life Member

    Messages:
    148
    Likes Received:
    0
    Joined:
    May 29, 2004
    Location:
    ILL
    iRow = ws.Cells(Rows.Count, 2) _
    .End(xlUp).Offset(1, 0).Row

    Looks like you are setting iRow plus 1 with this code (assuming you are trying to find the end of the rows and getting the first blank row) implying that you want to ADD.

    But if I figured out what you are trying to do, which is update what you found in sheet CHRIS, you've got the row in NuckolsCell so pass that over to cmdSubmit_Click() (in a global variable?).

    Anyway, good luck.
     
  10. Fernman

    Fernman Zombie Jeebus! CLM

    Messages:
    1,414
    Likes Received:
    0
    Joined:
    Feb 14, 2005
    Location:
    Virginia
    I was being dumb...needed a form level variable for row. Got it working now :)