Posts by mycomputerguy-w

Re: Plain input box with no buttons and a message baox at the end.

'Bump'

Re: Plain input box with no buttons and a message box at the end.

Lets see if i can explain this a little better. Im attempting to build a checkin access system that will allow members to swipe their membership cards and gain access to an exercise program. this system is not going to "allow" or "deny" access to anything. All it will do is log them into the class. After swiping their card, it will take the comma delimited information that was previously encoded onto the card and accept it into the input box. At this point im not sure how i should "collect" the information but i was thinking an input box would work. Im guessing I need a way to read the input from a magstripe reader and maybe export it to a text file then import it right back into the workbook? Im not sure if there is a way for it to be read directly into the active sheet? any help or direction would be greatly appreciated.

Re: Import a text file with a twist

ok....understood

Im very new to VBA, Macros and such but im attempting to learn. Here is my quest: I need to import comma delimited text files into my workbook. The files will always have a different name so rather than recording a specific marco for each text file, I'd like to be able to run a macro that will allow the user to choose the file, then input the information on the next available row. Ive included the recorded macro that i did where it gets a specific file to show settings i need. If a completly different solution is neccessary that is ok too. Thanks for your help in advance.

Sub Import() 
    With ActiveSheet.QueryTables.Add(Connection:= _ 
        "TEXT;C:\Users\Public\Documents\Txt files\100006.txt", Destination:=Range( _ 
        "$A$1")) 
        .Name = "100006_3" 
        .FieldNames = True 
        .RowNumbers = False 
        .FillAdjacentFormulas = False 
        .PreserveFormatting = True 
        .RefreshOnFileOpen = False 
        .RefreshStyle = xlInsertDeleteCells 
        .SavePassword = False 
        .SaveData = True 
        .AdjustColumnWidth = True 
        .RefreshPeriod = 0 
        .TextFilePromptOnRefresh = False 
        .TextFilePlatform = 437 
        .TextFileStartRow = 1 
        .TextFileParseType = xlDelimited 
        .TextFileTextQualifier = xlTextQualifierDoubleQuote 
        .TextFileConsecutiveDelimiter = False 
        .TextFileTabDelimiter = False 
        .TextFileSemicolonDelimiter = False 
        .TextFileCommaDelimiter = True 
        .TextFileSpaceDelimiter = False 
        .TextFileColumnDataTypes = Array(9, 1, 1, 1, 1, 1, 1, 1, 1, 9) 
        .TextFileTrailingMinusNumbers = True 
        .Refresh BackgroundQuery:=False 
    End With 
    
End Sub

im trying to create an input box that will take input from a card reader, (keyboard emulation), accept what is read into the the input box,(i'm guessing i need a carridge return here) then display a message box saying "Thank You" (for instance), Then return to the original input box and wait for the next entry.

Im still in need of a little assistance if someone has the time. i figured out how to write most of the macro but now im in a little over my head. The code below works to import a specific file. What i need to do is pause the macro to allow the user to choose the file to be imported, then have the information imported to the next available row instead of over writing row a1. any help would be great.

Sub Import()
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Users\Public\Documents\Txt files\100006.txt", Destination:=Range( _
        "$A$1"))
        .Name = "100006_3"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(9, 1, 1, 1, 1, 1, 1, 1, 1, 9)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Rows("2:2").Select
    Selection.Delete Shift:=xlUp
End Sub

Re: Importing a text file into the active sheet

ok, please enlighten me, which tags did you remove? when i post code i click the # icon above and paste the code between them. is that not what im suppose to do??

Re: Importing a text file into the active sheet

they are code tags, it shows up just fine with i paste it into the window while im writing the thread but as soon as i post it, i get what you see above.

Re: Importing a text file into the active sheet

Can someone explain what im doing wrong with posting code so I can fix this and make it look right?

Id like to start by saying, You all have been a God send for me and i am glad that i joined this fourm. Not only am i learning alot but im able to complete projects that have been thrown aside due to lack of knowledge. So here is my issue. I found this code below on another site and would like to use it or maybe someone has a better idea. I need to import text files into my active sheet.

The text files are created by a magnetic stripe encoder and look like this: "%Fname Lname address city st. zipcode telephone?;member number?"( minus the "" they are there for seperation factor only. % . ; ? are there just as you see them) so im sure the data will have to be trimed. Field names are as follows in this order:

Member Number, First Name, Last Name, Address 1, Address 2, City, St, Zipcode, Phone

What im wanting to do is:

1: read the card with a mag stripe reader into a "collection window" so to speak and have it input the data into the named fields OR

2: have a macro that can open a selection window so the user can choose the text file then have the macro read the text into the named fields.

Sub ImportTxt()


' Modify the constants below according to your import configuration
Const qName = "Pro_Co_Serv_Eval_NM" ' <-- Don't use space chars in name!
Const SheetImport = "ImportData"
Const CellImport = "A1"


Dim fName As Variant


' Display dialog for user to select a text file
fName = Application.GetOpenFilename("Text Files (*.txt), *.txt")


' If cancel then macro ends here
If fName = False Then MsgBox "Canceled": Exit Sub


' Import text file
With Sheets(SheetImport)
.Range(CellImport).CurrentRegion.ClearContents
With .QueryTables.Add(Connection:="TEXT;" & fName, Destination:=.Range(CellImport))
.Name = qName
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.TextFileStartRow = 4
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierNone
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
.Delete ' <-- Close quire
End With


' Remove all names added by quire calls
For Each n In .Names
If InStr(1, n.Name, qName, 1) > 0 Then
n.Delete
End If
Next


End With


' Something else
' ...


End Sub

Re: Unprotect cell to enter data then RE-protect cell

Excellent!! works perfectly. Thank you!

Here is my question. I need a way to use the macro below with an input box to collect the data but i need to be able to protect the sheet from "manual" entry into the cells. So really what i'm asking is this: Is there a way to collect data by using an input box, enter that collected data into the selected cells, and do all this without ever allowing the user to enter the cell manually? I know i can unprotect the individual cells but that allows the user to manually ,Change, Correct, Remove, or Format the data and that is what im attempting to stop. I want the user to be able to enter data only by using the pop up input box. Just as an added feature, I'd also like to force the text entered to "PROPER" if this is possible to do when using an input box.

Sub Input1()
    
    Dim LastRow As Object
        Set LastRow = Sheets("Member Entry").Range("A65536").End(xlUp)
    Dim Memnum As String
    Memnum = InputBox("Membership Number")
    LastRow.Offset(1, 0).Value = Memnum
    Dim firstname As String
    firstname = InputBox("First Name")
    LastRow.Offset(1, 1).Value = firstname
    Dim lastname As String
    lastname = InputBox("Last Name")
    LastRow.Offset(1, 2).Value = lastname
    Dim Address1 As String
    Address = InputBox("Address 1")
    LastRow.Offset(1, 3).Value = Address
    Dim Address2 As String
    Address2 = InputBox("Address 2")
    LastRow.Offset(1, 4).Value = Address2
    Dim city As String
    city = InputBox("City")
    LastRow.Offset(1, 5).Value = city
    Dim state As String
    state = InputBox("state")
    LastRow.Offset(1, 6).Value = state
    Dim zipcode As String
    zipcode = InputBox("Zip Code")
    LastRow.Offset(1, 7).Value = zipcode
    Dim PhoneNo As String
    PhoneNo = InputBox("Phone Number")
    LastRow.Offset(1, 8).Value = PhoneNo
End Sub

Im sure its nothing more than a code line im missing. I'll try to explain what this macro is doing first and then what id like it to do. Bear in mind that as it is now is ok, it works but it doesnt work to the best efficency.

When the user clicks the "Save Record" command button. This macro checks first to see if the cell b670 is filled, if not, it pops a message and asks to have the field filled and exits, if the cell is filled, then whatever is in the cell is what the filename will be. The same thing happens for cell B672 except that cell will be the sub directory under the default path. Once that is done it saves the work book, clears the 2 cells and, returns to the SAVED sheet. So here is what its missing. 1st, it saves the WHOLE workbook and id like it to save just the active sheet called 'Order Summary' and 1 other sheet called 'Order Entry'. 2nd Id like it to save them as a copy to the main workbook I am currenty working in and have it remain in that workbook rather than revert to the copy it just saved. I can attach a copy of the workbook to look at if that will help to understand the problem a little better, for now, here is the macro code:

Sub SaveAs()
If Range("B670") = "" Then
        MsgBox ("Please fill in Boat Number.")
        Exit Sub
    ElseIf Range("B672") = "" Then
        MsgBox ("Please fill in Company Name.")
        Exit Sub
End If
Dim strFilename, strDirname, strPathname, strDefpath As String
On Error Resume Next ' If directory exist goto next line
strDirname = Range("B672").Value ' New directory name will be whatever is put into this cell
strFilename = Range("B670").Value 'New file name will be whatever is in this cell
strDefpath = "C:\Users\Bench\Desktop\Order Entry\" 'Default path name
If IsEmpty(strDirname) Then Exit Sub
If IsEmpty(strFilename) Then Exit Sub
MkDir strDefpath & strDirname
strPathname = strDefpath & strDirname & "\" & strFilename 'create total string
ActiveWorkbook.SaveAs.Copy Filename:=strPathname, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
For Each Cell In Range("B670:B672")
If Cell > 0 Then Cell.ClearContents
Next
MsgBox ("Record Saved.")
End Sub

Re: macro will not move the highlight correctly

Works Perfect! Thank you for taking ther time to respond.

I will do my best to explain my situation as best I can. The following code was found on another fourm and customized to do what I need and works great for my needs. It is code that is used on a button click to pop up an input box to get user input. It then takes the user input, which is a number, AND takes whatever number is in the "Active Cell" (Selected Cell), adds them together and puts the result back into the "Active Cell". By clicking ok, the input box remains in view and asks again for the amount to be added to the next "Active Cell". This process will continue until cancel is clicked on the input box. That part works great, with the exception, After clicking "OK" on the input box, the highlight for the active cell ( the black outline of the cell) does not move to the next cell to be edited. (Which in my case is the next cell down in the column) The functions work fine and this problem is more of a visual fix. Really all I need to do is make the highlight of the cell that is currently being updated move to that cell. I know this is a very simple fix but I have yet to be able to remember the code line neccessary to make "that little black highlight border" move to the next cell. Feel free to try the code to see what im talking about and you'll understand right away what I'm asking for. As long as i'm asking maybe someone can suggest some code to add to this macro to actually highlight the active cell with a different color. Say turn the active cell a light gray or something along that line. Thank you in advance to all of you that can/willl help.

Sub AddToCell()
Const intLastCol As Integer = 10
Dim sngValue1 As Single
Dim blnEnd As Boolean
Dim n As Integer
Dim strUserInput As String
Do Until ActiveCell.Column > intLastCol Or blnEnd
sngValue1 = ActiveCell.Offset(n, 0).Value
strUserInput = InputBox("Current Amount: " & sngValue1, "Enter Amount to Add to Current Amount")
If strUserInput <> "" Then
sngValue1 = CSng(strUserInput) + sngValue1
ActiveCell.Offset(n, 0).Value = sngValue1
Else
blnEnd = True
End If
n = n + 1
Loop
End Sub