Wrox Programmer Forums
|
Excel VBA Discuss using VBA for Excel programming.
Welcome to the p2p.wrox.com Forums.

You are currently viewing the Excel VBA section of the Wrox Programmer to Programmer discussions. This is a community of software programmers and website developers including Wrox book authors and readers. New member registration was closed in 2019. New posts were shut off and the site was archived into this static format as of October 1, 2020. If you require technical support for a Wrox book please contact http://hub.wiley.com
 
Old April 19th, 2006, 07:34 AM
Authorized User
 
Join Date: Apr 2006
Posts: 10
Thanks: 0
Thanked 0 Times in 0 Posts
Default overwriting data

I'm having a problem figuring out how to add a row to a range and then writing to the new row. Here's the code on my userform:

Private Sub SaveRecord()
'Add new record at bottom of database
  Dim RowCount As Integer

Range("expenditures").Select
  With Range("expenditures")
    'Add extra row to name Database
    RowCount = .Rows.Count + 1
    .Resize(RowCount).Name = "expenditures"
    Set RangeData = .Rows(1)


ReDim Data(1 To 1, 1 To 8)

   'Copy values from ExpenditureForm controls to Data array
        Data(1, 1) = txtSEQ.Value
        Data(1, 2) = cboOrgShp.Value
        Data(1, 3) = txtNsn.Value
        'Data(1, 4) = Application.WorksheetFunction.VLookup(txtNsn.Value , "Stock_num!AF_noun_tx", 2, False)
        Data(1, 5) = txtDoc.Value
        Data(1, 6) = txtLot.Value
        Data(1, 7) = txtQty.Value
        Data(1, 8) = txtCatCode.Value


   'Assign Data array values to current record in Database
   RangeData.Value = Data
End With
Call Unload(ExpForm)

End Sub

 
Old April 19th, 2006, 09:19 AM
Friend of Wrox
 
Join Date: Jun 2003
Posts: 173
Thanks: 0
Thanked 3 Times in 3 Posts
Default

This should do for you

Code:
Private Sub SaveRecord()
'Add new record at bottom of database

Dim rngExp As Range
Dim RowCount As Integer

    Set rngExp = Range("Expenditures")
    RowCount = rngExp.Rows.Count + 1

    ActiveWorkbook.Names.Add Name:="Expenditures", _
        RefersTo:="=" & rngExp.Parent.Name & "!" & rngExp.Resize(RowCount).Address

    Set rngExp = Range("Expenditures")
    Set RangeData = rngExp.Rows(RowCount)

    ReDim Data(1 To 1, 1 To 8)

    'Copy values from ExpenditureForm controls to Data array
    Data(1, 1) = txtSEQ.Value
    Data(1, 2) = cboOrgShp.Value
    Data(1, 3) = txtNsn.Value
    'Data(1, 4) = Application.WorksheetFunction.VLookup(txtNsn.Value, "Stock_num!AF_noun_tx", 2, False)
    Data(1, 5) = txtDoc.Value
    Data(1, 6) = txtLot.Value
    Data(1, 7) = txtQty.Value
    Data(1, 8) = txtCatCode.Value

    'Assign Data array values to current record in Database
    RangeData.Value = Data
    Call Unload(ExpForm)

End Sub
 
Old April 19th, 2006, 02:50 PM
Authorized User
 
Join Date: Apr 2006
Posts: 10
Thanks: 0
Thanked 0 Times in 0 Posts
Default

First - thanks!!! I'm just learning VBA and you've been a great help.

K, i've got it working using parts of the code you posted. I already had figured out the "name" situation so i left that part of your code out. Now my problem is getting the validation parts to work properly. In the form, i've got different fields that are numeric only, fields that are alpha-numeric and some that are alpha only. How do i get the code to check the data before the output. Here's my current coding on the form itself:

Option Explicit
Option Base 1
Private Data() As Variant
Private RangeData As range
Private Number As Integer
Private Text As String



Public Cancelled As Boolean


Private Sub cmdNewExp_Click()


End Sub
Private Sub cmdClear_Click()
  Cancelled = True
  Me.Hide
End Sub


Private Sub ExpForm_Initialize()

End Sub

Private Sub cmdSubmit_Click()
  Cancelled = False
  SaveRecord
End Sub


Private Sub ExpForm_QueryClose(Cancel As Integer, _
  CloseMode As Integer)

  If (CloseMode = vbFormControlMenu) Then
    Cancel = True
    Beep
  End If
End Sub



Private Sub SaveRecord()
'Add new record at bottom of database
  Dim RowCount As Integer
  Dim stock_num As String
  Dim Af_noun_tx As String




range("expenditures").Select
  With range("expenditures")
    'Add extra row to name Database
    RowCount = .Rows.Count + 1
    .Resize(RowCount).Name = "expenditures"
    Set RangeData = .Rows(RowCount)

  End With
ReDim Data(1 To 1, 1 To 8)

   'Copy values from ExpenditureForm controls to Data array
        Data(1, 1) = txtSEQ.Value
        Data(1, 2) = cboOrgShp.Value
        Data(1, 3) = txtNsn.Value
        'Data(1, 4) = Application.WorksheetFunction.VLookup(Data(1, 3), Range("STOCK_NOUN_CROSSREF"), 2, False)
        Data(1, 5) = txtDoc.Value
        Data(1, 6) = txtLot.Value
        Data(1, 7) = txtQty.Value
        Data(1, 8) = txtCatCode.Value


   'Assign Data array values to current record in Database
   RangeData.Value = Data

Call Unload(ExpForm)

End Sub

Sub ValidStock()
Dim oValid As Validation
Set oValid = Selection.Validation
With oValid
    .Delete
    .Add Type:=xlValidateWholeNumber, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="1", Formula2:="9999999999999"
    .ShowInput = False
    .ShowError = True
    .ErrorTitle = "error"
    .ErrorMessage = "Please enter a valid Number"
End With

End Sub

Red items are numeric only, green items are alpha numeric, blue items are alpha only. The underlined item HAS to be 13-15 characters and the bold item HAS to be 14 characters. I don't know where to put the CALL function for the validation check. And, I'm pretty sure it won't do everything I need it to. I may have to have several different validation checks inside nested loops. Finally, the DATA (1, 4) line doesn't work. I get an error stating "unable to get the vlookup property of the worksheetfunction class". This whole project has turned out to be way over my head. I greatly appreciate the help.

 
Old April 20th, 2006, 03:26 AM
Friend of Wrox
 
Join Date: Jun 2003
Posts: 173
Thanks: 0
Thanked 3 Times in 3 Posts
Default

Bryan,

I think this is waht you're asking after ...

Code:
Option Explicit
Option Base 1

' *******************************************************
' Form level declarations
' *******************************************************

Private Data(1, 8) As Variant
Private RangeData As Range
Private Number As Integer
Private Text As String
Public Cancelled As Boolean

' *******************************************************
' Form event handlers
' *******************************************************

Private Sub cmdNewExp_Click()

End Sub

Private Sub cmdClear_Click()

    Cancelled = True
    Me.Hide

End Sub

Private Sub UserForm_Initialize()

End Sub

Private Sub cmdSubmit_Click()

    Cancelled = False
    SaveRecord

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

    If (CloseMode = vbFormControlMenu) Then
        Cancel = True
        Beep
    End If

End Sub

' *******************************************************
' Custom Subroutines & Functions
' *******************************************************

Private Sub SaveRecord()
'Add new record at bottom of database

Dim RowCount As Integer
Dim stock_num As String
Dim Af_noun_tx As String

    ' Validate entries
    If Not Validate Then Exit Sub

    'Add extra row to name Database
    With Range("Expenditures")
        RowCount = .Rows.Count + 1
        .Resize(RowCount).Name = "Expenditures"
        Set RangeData = .Rows(RowCount)
    End With

    'Copy values from ExpenditureForm controls to Data array
    Data(1, 1) = txtSEQ.Value     ' numeric
    Data(1, 2) = cboOrgShp.Value  ' none
    Data(1, 3) = txtNsn.Value     ' numeric 13-15
    Data(1, 4) = Application.VLookup(Data(1, 3), Range("STOCK_NOUN_CROSSREF"), 2, False) ' alpha num
    Data(1, 5) = txtDoc.Value     ' alpha num 14
    Data(1, 6) = txtLot.Value     ' alpha num
    Data(1, 7) = txtQty.Value     ' numeric
    Data(1, 8) = txtCatCode.Value ' alpha

    'Assign Data array values to current record in Database
    RangeData.Value = Data

    ' Unload the form
    Call Unload(Me)

End Sub

Private Function Validate() As Boolean

    ' Validate txtSEQ
    If Not IsNumeric(txtSEQ.Value) Then
        MsgBox "txtSEQ must contain a number only"
        Validate = False
        Exit Function
    End If

    ' Validate cboOrgShp

    ' Validate txtNsn
    If (Not IsNumeric(txtNsn.Value)) Or (Len(txtNsn.Value) < 13) Or (Len(txtNsn.Value) > 15) Then
        MsgBox "txtNsn must contain a 13 to 15 digit number only"
        Validate = False
        Exit Function
    End If

    ' Validate txtDoc
    If (Not IsAlphaNumeric(txtDoc.Value)) Or (Len(txtDoc.Value) <> 14) Then
        MsgBox "txtDoc must contain a 14 character alpha numeric string only"
        Validate = False
        Exit Function
    End If

    ' Validate txtLot
    If Not IsAlphaNumeric(txtLot.Value) Then
        MsgBox "txtLot must be an alpha numeric string only"
        Validate = False
        Exit Function
    End If

    ' Validate txtQty
    If Not IsNumeric(txtQty.Value) Then
        MsgBox "txtQty must contain a number only"
        Validate = False
        Exit Function
    End If

    ' Validate txtCatCode
    If Not IsAlpha(txtCatCode.Value) Then
        MsgBox "txtCatCode must be an alpha string only"
        Validate = False
        Exit Function
    End If

    Validate = True

End Function

Private Function IsAlphaNumeric(strTest) As Boolean
' Custom function to test for Alpha Numeric strings

Dim Char As String
Dim CharNum As Integer
Dim i As Integer

    For i = 1 To Len(strTest)

        Char = Mid(strTest, i, 1)
        CharNum = Asc(Char)

        If CharNum < 48 Or _
           (CharNum > 57 And CharNum < 65) Or _
           (CharNum > 90 And CharNum < 97) Or _
           CharNum > 122 Then

            IsAlphaNumeric = False
            Exit Function

        End If

    Next i

    IsAlphaNumeric = True

End Function

Private Function IsAlpha(strTest) As Boolean
' Custom function to test for Alpha strings

Dim Char As String
Dim CharNum As Integer
Dim i As Integer

    For i = 1 To Len(strTest)

        Char = Mid(strTest, i, 1)
        CharNum = Asc(Char)

        If CharNum < 65 Or _
           (CharNum > 90 And CharNum < 97) Or _
           CharNum > 122 Then

            IsAlpha = False
            Exit Function

        End If

    Next i

    IsAlpha = True

End Function
 
Old April 20th, 2006, 05:50 AM
Authorized User
 
Join Date: Apr 2006
Posts: 10
Thanks: 0
Thanked 0 Times in 0 Posts
Default

Maccas - I owe you man!!!! this is outstanding. I never would have picked that out the book anywhere. Thanks again!!!!

I don't understand how the ISAlpha and ISALPHANUMERIC test work though. Can you explain?

 
Old April 20th, 2006, 06:08 AM
Friend of Wrox
 
Join Date: Jun 2003
Posts: 173
Thanks: 0
Thanked 3 Times in 3 Posts
Default

Bryan,

No worries, glad I could help.

The IsAlpha and IsAlphaNumeric tests are custom function written to test alpha and alpha numeric-ness as there is no in-built VBA functionality to test for this (unlike IsNumeric). What they do is they take an input string and look at each character of the string in sequence. They both use the VBA function Asc() which converts a string character into its ASCII code number. Because the ASCII code numbers for numbers and letters are blocked together it is then quite simple to test whether each ASCII code number is within the correct ranges. If the function finds any character with a code number outside the correct ranges then the function trips out with an error, if the function gets through every character without error then the whole string must be good.

Maccas

 
Old April 20th, 2006, 01:56 PM
Authorized User
 
Join Date: Apr 2006
Posts: 10
Thanks: 0
Thanked 0 Times in 0 Posts
Default

OK, so if i wanted to add, say dashes, to one of my validations, I would just have to look up the ASCII number for it and include it in the validation? Sounds pretty simple.

The vlookup is still not working though. the data range is on a seperate sheet, the range listed in the function is correct and the "name" is correct. Any ideas? I get an #na error on the sheet and nothing shows up on the form itself when you type in the stock number on the line above it.

Also, is it possible to automatically assign a SEQ # based on the Org/Shp. I may have to rearrange my form so the Org/Shp is entered first then the number is assigned.



 
Old April 21st, 2006, 03:28 AM
Friend of Wrox
 
Join Date: Jun 2003
Posts: 173
Thanks: 0
Thanked 3 Times in 3 Posts
Default

Absolutely, dashes are char no 46 or 173 and you may also find the space char useful as no 32. You can look all these up on the VBA help.

Personally, I find the WorksheetFunctions in VBA a bit flakey. If you're still having trouble I'd recommend that you write your own VBA version of VLOOKUP. Something along the lines of the following should do the trick:
Code:
Private Function myVLOOKUP(strSearch As String, rngSearch As Range, intReportCol As Integer) As String

Dim Cell As Range
Dim i As Integer

    For i = 1 To rngSearch.Rows.Count
        Set Cell = rngSearch.Cells(i, 1)
        If Cell.Text = strSearch Then
            myVLOOKUP = Cell.Offset(0, intReportCol - 1).Text
            Exit Function
        End If
    Next i

End Function
From the sounds of it you would actually like the form to dynamically populate a couple of the fields when others are updated. To do this you will need to use the change event handlers of initiator fields. E.G. You should create an event handler for txtNsn along the lines of(assuming that you have a text box called txtStock for the stock name linked to the txtNsn value):
Code:
Private Sub txtNsn_Change()

    txtStock.value = myVLOOKUP(txtNsn.value,Range("STOCK_NOUN_CROSSREF"), 2)

End Sub
Given that you're doing stuff with the values in the text fields you may want to put the validation of each of the fields into their change event handlers rather than at the form submit point.

Maccas

 
Old April 21st, 2006, 01:59 PM
Authorized User
 
Join Date: Apr 2006
Posts: 10
Thanks: 0
Thanked 0 Times in 0 Posts
Default

Thanks macas. the myvlookup function works great!! I've started codeing the change event on my combobox with the OrgShp to (Auto)display the correct sequence number. Wish me luck. I've posted some already under "Codeing help". in excel vba forum.

thanks again for all the help!!!!





Similar Threads
Thread Thread Starter Forum Replies Last Post
overwriting files mrjits Excel VBA 2 August 1st, 2006 02:53 PM
Overwriting fields in a table caterpillar SQL Server 2000 3 July 24th, 2006 09:00 AM
Generated Code Overwriting PWD rodmcleay ADO.NET 1 November 28th, 2005 04:27 AM
overwriting file ozPATT Excel VBA 0 October 14th, 2005 04:49 AM





Powered by vBulletin®
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright (c) 2020 John Wiley & Sons, Inc.