Excel VBA / Macro Programming Help! [Archive] - Glock Talk

PDA

View Full Version : Excel VBA / Macro Programming Help!


Fernman
07-09-2007, 13:00
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.

elderboy02
07-09-2007, 19:48
I have written bookoo VBA code in Word and Access, but not excel. Post it up and I will try.

Fernman
07-10-2007, 11:44
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

Fernman
07-10-2007, 11:45
I got the search/display working. All I need is the cmdNuckols button to UPDATE the entry, not create a new one... HALP!

elderboy02
07-10-2007, 12:35
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?

Fernman
07-10-2007, 12:38
I can email the file :)

WhatYouWant
07-10-2007, 16:30
This seems to be that you should write it in Access. Access sucks but it is better than excel for your task.

elderboy02
07-10-2007, 17:02
Originally posted by Fernman
I can email the file :)

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.

JVMHGF
07-12-2007, 22:41
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.

Fernman
07-12-2007, 23:44
I was being dumb...needed a form level variable for row. Got it working now :)