Help with coding a command button.


dan dungan


I'm researching how to migrate an excel workbook used for quoting to
Access. I need to recall quotes for correction and approval. To
understand the tables I'll need, I'm trying to collect data to

So, using excel 2000 and windows xp, I've got a command button on a
locked spreadsheet.

The on click event stopped working when I added more functionality--I
want to add exporting the unprotected cells to a pipe delimited text
file--each time the user clicks should be a new record in the text
file. So I can have data to analyze.

When I added the code, it created a text file with the following

(I deleted some of the rows for display purposes.)


The first Unexpected or Unwanted behavior:

1. Excel had errors and had to shut down.
2. This data should all be in one row--not 7 rows.
3. None of the data in the cells shows up in the file.

I show the code from the on-click event below. First I show what I

Thanks for your suggestions and help.

Here's the code I added from Debra Dalgleish.
I put this in a module--modExport--and called it from the on click

Sub GetUnlocked()
Dim c As Range
Dim rng2 As Range

For Each c In ActiveSheet.UsedRange
If Not (c.Locked) Then
If Not rng2 Is Nothing Then
Set rng2 = Union(c, rng2)
Set rng2 = c
End If
End If
Next c
End Sub
Then I called a procedure from the same module that I found on Chip
Pearson's site:

Public Sub ExportToTextFile(FName As String, _
Sep As String, SelectionOnly As Boolean, _
AppendData As Boolean)

Dim WholeLine As String
Dim FNum As Integer
Dim RowNdx As Long
Dim ColNdx As Integer
Dim StartRow As Long
Dim EndRow As Long
Dim StartCol As Integer
Dim EndCol As Integer
Dim CellValue As String

Application.ScreenUpdating = False
On Error GoTo EndMacro:
FNum = FreeFile

If SelectionOnly = True Then
With Selection
StartRow = .Cells(1).Row
StartCol = .Cells(1).Column
EndRow = .Cells(.Cells.Count).Row
EndCol = .Cells(.Cells.Count).Column
End With
With ActiveSheet.UsedRange
StartRow = .Cells(1).Row
StartCol = .Cells(1).Column
EndRow = .Cells(.Cells.Count).Row
EndCol = .Cells(.Cells.Count).Column
End With
End If

If AppendData = True Then
Open FName For Append Access Write As #FNum
Open FName For Output Access Write As #FNum
End If

For RowNdx = StartRow To EndRow
WholeLine = ""
For ColNdx = StartCol To EndCol
If Cells(RowNdx, ColNdx).Value = "" Then
CellValue = Chr(34) & Chr(34)
CellValue = Cells(RowNdx, ColNdx).Text
End If
WholeLine = WholeLine & CellValue & Sep
Next ColNdx
WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
Print #FNum, WholeLine
Next RowNdx

On Error GoTo 0
Application.ScreenUpdating = True
Close #FNum

End Sub

So here is the code I'm using:

Private Sub cmdAddPart_Click()
'To prepare for printing--This checks that all required component
prices are entered
Dim rng As Range
Dim myRng As Range
Set myRng = Range("FormulaCriteria")

Dim qRng As Range
Dim qmyRng As Range
Set qmyRng = Range("QuantityRange")

'To determine how many parts the agent has added,
'Set a variable to count how many times the agent clicks the command

Dim clickcount As Variant
'If I don't do the following,
Application.EnableEvents = False
'ActiveWorkbook.Unprotect ("pricing")

'This part validates the entries:

If Cells("2", "A").Value = "" Then
MsgBox "You have not entered a Part Number to quote.",
Exit Sub
End If
If Cells("4", "I").Value < 10 Then
MsgBox "Please enter the appropriate Quote Number.", vbOKOnly
Exit Sub
End If

If Cells("2", "D").Value = "" Then
MsgBox "You have not entered a Connector Code.", vbOKOnly
Exit Sub
End If
If Cells("4", "D").Value = "" Then
MsgBox "You have not entered a Customer Name to quote.",
Exit Sub
End If

For Each rng In myRng

If Len(rng.Value) >= 1 And rng.Offset(0, 7).Value < 1 Then
MsgBox rng.Offset(-1, 0).Value & vbCrLf & "missing.",
vbOKOnly, "Missing Price Error"
Exit Sub
End If
Next rng

If WorksheetFunction.Sum(Range("E83:O83")) < 1 Then
MsgBox "You have not entered a quantity", vbOKOnly
Exit Sub
End If
For Each qRng In qmyRng

If Len(qRng.Value) >= 1 And qRng.Offset(3, 0).Value < 1 Then
MsgBox "Please enter the lead time for this quantity.",
vbOKOnly, "Missing Price Error"
Exit Sub
End If
Next qRng

'Here's where I called the procedures:


clickcount = txtCount + 1
txtCount = clickcount
Worksheets("QuotedPart").Cells(2, 1).Value = ""
Worksheets("QuotedPart").Cells(2, 5).Value = ""
'ActiveWorkbook.Protect password:="pricing"
cboPartnum.Value = ""
cboPartnum.Visible = False
Application.EnableEvents = True
End Sub




First, Comment out all the ON Eror Statments so you can find the real error

On Error GoTo EndMacro:

Add a single quote in front of this statement so you can find the errors.

I recomment stepping through the code and finding where the code stops

1) Add break point by going to 1st line of the macro and clicking with the
mouse. then press F9 to add break point.
2) Step through code after break point is set by typing F8.
3) you can add many break points. To go from 1 break point to the next type
F5 which will run to end of code or until the next break point.

Find out where you stop executing.

Also you may want to change you error trapping from VBA menu

Tool - Options - General - Break on all errors.


Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question