Consulting

Results 1 to 17 of 17

Thread: VBA coding help

  1. #1

    VBA coding help

    There is a database of addresses that have new postal code. I am given one sheet with all of the codes and then given one sheet with the addresses. I want the user to input the address number, name and suffix so that the program can run through the list of codes and spit out the correct value.The address number that the user inputs must fall within a range that corresponds with the new postal codes. The numbers for this range are in the same row but in two different cells and I am having trouble figuring out how to capture the value in those two different cells. I want to check to see whether the value that the user inputs (ex. street number 4) falls into the range of the two values (ex. 1 to 75 or 75 to 1). The tricky part also is the values for the ranges are not in cosecutive order. This is the code I have so far.


    [vba]
    Sub hi()
    Dim rowCount2 As Integer
    Dim i As Integer
    Dim j As Integer
    Dim ValueOne As Variant
    Dim Valuetwo As Variant
    Dim Cell As Range


    Sheets("Sheet2").Select
    rowCount2 = Cells(Cells.Rows.Count, "A").End(xlUp).Row
    For i = 1 To rowCount2
    Range("D" & i).Select
    ValueOne = Range("D" & i).Value

    Range("E" & i).Select
    Valuetwo = Range("E" & i).Value

    If usrInputStreetNumber >= ValueOne And usrInputStreetNumber <= Valuetwo Then

    End If
    Next


    End Sub
    [/vba]
    Last edited by fastlanenate; 08-21-2012 at 09:44 AM.

  2. #2
    VBAX Expert CatDaddy's Avatar
    Joined
    Jun 2011
    Posts
    581
    Location
    hey man looks like what you need is totally doable and you are off to a good start (although the selection steps are unnecessary) if you post a sample workbook(s) that would make helping you a lot easier, also put your code samples in the vba tags provided in the top ribbon of the text box
    [VBA]'It sets your code apart and makes it easier to read[/VBA]
    ------------------------------------------------
    Happy Coding my friends

  3. #3
    dropbox.com/s/2wpfxpynms8zexi/SampleWorkbook.xlsm

    Here is a link to the sample work book

  4. #4
    VBAX Expert CatDaddy's Avatar
    Joined
    Jun 2011
    Posts
    581
    Location
    I cant get the link to work, if you go into the "Go Advanced" option you can attach the file to your post
    ------------------------------------------------
    Happy Coding my friends

  5. #5

    Code

    [VBA]Option Explicit
    Dim quitProgram As Boolean
    'declare variables
    Dim usrInputStreetNumber As String 'Store input Data
    Dim usrInputStreetName As Variant 'Store input Data
    Dim usrInputStreetType As Variant 'Store input Data
    Sub Main()
    Range("A1").Select
    'Declare variables
    Dim Response As Integer 'Store user input


    'Clear Sheet 2 before running program
    Sheets("Sheet2").Select
    Range("A2:Z6500").Clear

    Call getAddress
    Call cond_copy

    'set value for boolean variable to quit program
    quitProgram = False

    If quitProgram Then
    'Request confirmation from user
    'change the default button to be "No"
    Response = MsgBox("Do You really want to quit?", vbCritical + vbYesNo + vbDefaultButton2, "Please Respond")

    If Response = vbYes Then
    'QuitProgram
    End
    Else


    'Make quit program false again
    quitProgram = False
    End If
    End If

    'call procedure to display results
    ' printresults

    End Sub 'Main
    Sub getAddress()

    'procedure to get Address from user


    Dim StreetNumber As Double 'Store grade value

    'Loop until user enters valid data
    Do

    'request user input and assign it to variable
    usrInputStreetNumber = InputBox("Street #: " & vbCrLf & _
    "Please enter a Street number" & _
    "Enter ""Q "" to quit program", "Data input", , _
    2000, 7000)

    'check type of data entered by user
    'If grade is numeric, assign it to numerical variable

    If IsNumeric(usrInputStreetNumber) Then
    StreetNumber = CDbl(usrInputStreetNumber)
    If StreetNumber < 0 Then
    'notify the user of error
    MsgBox "Please enter a numerical value!", _
    vbCritical, "Incorrect Input"

    Else
    'Grade is valid
    'Exit Do
    Exit Do

    End If

    ElseIf usrInputStreetNumber = "Q" Then
    quitProgram = True
    Exit Sub
    Else
    MsgBox "Please enter a numerical value!", _
    vbCritical, "Incorrect Input"
    End If
    Loop




    'request user input and assign it to variable
    usrInputStreetName = UCase(InputBox("Street Name: " & vbCrLf & _
    "Please enter a Street Name" & _
    "Enter ""Q"" to quit program", "Data input", , _
    2000, 7000))

    'check type of data entered by user
    'If grade is numeric, assign it to numerical variable

    If usrInputStreetName = "" Then
    'User pressed Cancel or OK button
    MsgBox "User pressed the ""Cancel"" button" & vbCrLf & _
    "or entered nothing", _
    vbExclamation, "Cancel button"
    End If

    If usrInputStreetName = "Q" Then
    quitProgram = True
    Exit Sub

    End If



    'request user input and assign it to variable
    usrInputStreetType = UCase(InputBox("Street Type: " & vbCrLf & _
    "Please enter a Street Type" & _
    "Enter ""Q "" to quit program", "Data input", , _
    2000, 7000))

    'check type of data entered by user
    'If grade is numeric, assign it to numerical variable

    If usrInputStreetType = "" Then
    'User pressed Cancel or OK button
    MsgBox "User pressed the ""Cancel"" button" & vbCrLf & _
    "or entered nothing", _
    vbExclamation, "Cancel button"
    End If

    If usrInputStreetName = "Q" Then
    quitProgram = True
    Exit Sub
    End If

    'HIGHLIGHT ROW
    ' Range(Range("A1:M1"), Range("A1:M1").End(xlDown)).Select
    ' Dim Cell As Range
    ' Dim Row As Range

    ' For Each cell In Selection
    ' If cell = usrInputStreetName Then cell.EntireRow.Interior.ColorIndex = 4
    'Next cell

    ' For Each Row In Selection
    ' If Row = usrInputStreetName Then Row.EntireRow.Select
    ' Next Row

    End Sub 'getAddrESS
    Sub cond_copy()
    Dim rOWCOUNT As Integer
    Dim rowCount2 As Integer
    Dim i As Integer
    Dim Check_Value As Variant

    'assuming the data is in sheet1
    Sheets("8100Loop").Select
    'Count number of rows in 8100Loop Sheet
    rOWCOUNT = Cells(Cells.Rows.Count, "H").End(xlUp).Row
    For i = 1 To rOWCOUNT
    'assuming the user input street name is in column H
    Range("H" & i).Select
    Check_Value = ActiveCell
    If Check_Value = usrInputStreetName Then
    'copy entire row
    ActiveCell.EntireRow.Copy
    'assuming the data is in sheet2
    Sheets("Sheet2").Select
    'paste entire row in column A on sheet 2
    rOWCOUNT = Cells(Cells.Rows.Count, "a").End(xlUp).Row
    Range("a" & rOWCOUNT + 1).Select
    ActiveSheet.Paste
    Sheets("8100Loop").Select
    End If
    Next

    'Code To delete non corresponding street type
    'assuming the data is in sheet2
    Sheets("Sheet2").Select
    'Count number of rows in Sheet 2
    rOWCOUNT = Cells(Cells.Rows.Count, "I").End(xlUp).Row
    For i = 1 To rOWCOUNT
    'assuming the user input street type is in column I
    Range("I" & i).Select
    Check_Value = ActiveCell
    If Not Check_Value = usrInputStreetType Then
    'Clear entire row
    ActiveCell.EntireRow.Clear
    Sheets("Sheet2").Select
    End If
    Next



    End Sub
    Sub copyrows()

    Dim tfCol As Range, Cell As Object

    Set tfCol = Range("A2:A9") ' True/False values

    For Each Cell In tfCol

    If IsEmpty(Cell) Then
    Exit Sub
    End If

    If Cell.Value = "True" Then
    Cell.EntireRow.Copy
    Sheet2.Select
    ActiveSheet.Range("A65536").End(xlUp).Select
    Selection.Offset(1, 0).Select
    ActiveSheet.Paste
    End If

    Next

    End Sub
    Sub hi()
    Dim rowCount2 As Integer
    Dim i As Integer
    Dim j As Integer
    Dim ValueOne As Variant
    Dim Valuetwo As Variant
    Dim Cell As Range


    Sheets("Sheet2").Select
    rowCount2 = Cells(Cells.Rows.Count, "A").End(xlUp).Row
    For i = 1 To rowCount2
    Range("D" & i).Select
    ValueOne = Range("D" & i).Value

    Range("E" & i).Select
    Valuetwo = Range("E" & i).Value

    If usrInputStreetNumber >= ValueOne And usrInputStreetNumber <= Valuetwo Then

    End If
    Next


    End Sub
    [/VBA]

  6. #6
    VBAX Expert CatDaddy's Avatar
    Joined
    Jun 2011
    Posts
    581
    Location
    i would like to see a mock up of your workbook and what you would like your output to look like
    ------------------------------------------------
    Happy Coding my friends

  7. #7

    File

    Here is the sample workbook. please use the code that i provided in the previous post. Thanks
    Attached Files Attached Files

  8. #8
    I would like the output to highlight the row and delete the rest of the rows

  9. #9
    VBAX Expert CatDaddy's Avatar
    Joined
    Jun 2011
    Posts
    581
    Location
    [VBA]'WHAT IS THIS PORTION OF THE CODE MEANT TO ACCOMPLISH?
    'HIGHLIGHT ROW
    ' Range(Range("A1:M1"), Range("A1:M1").End(xlDown)).Select
    ' Dim Cell As Range
    ' Dim Row As Range
    ' For Each cell In Selection
    ' If cell = usrInputStreetName Then cell.EntireRow.Interior.ColorIndex = 4
    ' Next cell
    ' For Each Row In Selection
    ' If Row = usrInputStreetName Then Row.EntireRow.Select
    ' Next Row[/VBA]
    ------------------------------------------------
    Happy Coding my friends

  10. #10
    VBAX Expert CatDaddy's Avatar
    Joined
    Jun 2011
    Posts
    581
    Location
    I made a few changes to your code that I think will get you closer but let me ask you are you just trying to copy the line that matches all the criteria the user inputs? if so there is a much easier way to do it
    Attached Files Attached Files
    ------------------------------------------------
    Happy Coding my friends

  11. #11
    Please ignore that highlight row portion, I kept it just in case i wanted to use it again. What I want to do is display the NEW Unit number that corresponds with the information that the user inputs. The street number will fall between the primaryLo and PrimaryHigh numbers. If it correctly matches that then the program should spit out the new unit number. If you know an easier way to do it that would be great
    Last edited by fastlanenate; 08-21-2012 at 01:54 PM.

  12. #12
    VBAX Expert CatDaddy's Avatar
    Joined
    Jun 2011
    Posts
    581
    Location
    what are you generating the new unit number by? and you want the result on Sheet2?
    ------------------------------------------------
    Happy Coding my friends

  13. #13
    The unit number is in column A on the "8100 Loop" sheet and Yes the result should be on page two please

  14. #14
    VBAX Expert CatDaddy's Avatar
    Joined
    Jun 2011
    Posts
    581
    Location
    [VBA]Option Explicit
    Dim quitProgram As Boolean
    Dim usrInputStreetNumber As Variant 'Store input Data
    Dim usrInputStreetName As Variant 'Store input Data
    Dim usrInputStreetType As Variant 'Store input Data
    Sub Main()
    'Declare variables
    Dim Response As Integer 'Store user input
    'Clear Sheet 2 before running program
    Sheets("Sheet2").Activate
    Range("A2:Z6500").Clear
    'Copy Header
    Sheets("8100Loop").Range("A1:M1").Copy Destination:=Sheets("Sheet2").Range("A1")
    'This was in the wrong place, overriding the other sub calls
    quitProgram = False
    Call getAddress
    Call cond_copy

    If quitProgram Then
    'Request confirmation from user
    'change the default button to be "No"
    Response = MsgBox("Do You really want to quit?", vbCritical + vbYesNo + vbDefaultButton2, "Please Respond")

    If Response = vbYes Then
    'QuitProgram
    Exit Sub
    Else
    'Make quit program false again
    quitProgram = False
    End If
    End If
    Sheets("Sheet2").Activate
    'YOU WANT TO DO SOMETHING MORE HERE??

    End Sub[/VBA]
    [VBA]Private Sub getAddress()
    'procedure to get Address from user

    Dim StreetNumber As Double

    'Loop until user enters valid data
    Do
    'request user input and assign it to variable
    usrInputStreetNumber = InputBox("Street #: " & vbCrLf & _
    "Please enter a Street number" & _
    "Enter ""Q "" to quit program", "Data input", , _
    2000, 7000)

    'check type of data entered by user
    'If grade is numeric, assign it to numerical variable

    If IsNumeric(usrInputStreetNumber) Then
    StreetNumber = CDbl(usrInputStreetNumber)
    If StreetNumber < 0 Then
    'notify the user of error
    MsgBox "Please enter a numerical value!", _
    vbCritical, "Incorrect Input"
    Else
    'Grade is valid
    Exit Do
    End If

    ElseIf usrInputStreetNumber = "Q" Then
    quitProgram = True
    Exit Sub
    Else
    MsgBox "Please enter a numerical value!", _
    vbCritical, "Incorrect Input"
    End If
    Loop
    Do
    usrInputStreetName = UCase(InputBox("Street Name: " & vbCrLf & _
    "Please enter a Street Name" & _
    "Enter ""Q"" to quit program", "Data input", , _
    2000, 7000))

    If usrInputStreetName = "" Then
    'User pressed Cancel or OK button
    MsgBox "User pressed the ""Cancel"" button" & vbCrLf & _
    "or entered nothing", _
    vbExclamation, "Cancel button"
    ElseIf usrInputStreetName = "Q" Then
    quitProgram = True
    Exit Sub
    Else
    'Valid Input
    Exit Do
    End If
    Loop
    Do
    usrInputStreetType = UCase(InputBox("Street Type: " & vbCrLf & _
    "Please enter a Street Type" & _
    "Enter ""Q "" to quit program", "Data input", , _
    2000, 7000))

    If usrInputStreetType = "" Then
    'User pressed Cancel or OK button
    MsgBox "User pressed the ""Cancel"" button" & vbCrLf & _
    "or entered nothing", _
    vbExclamation, "Cancel button"
    ElseIf usrInputStreetType = "Q" Then
    quitProgram = True
    Exit Sub
    Else
    'valid input
    Exit Do
    End If
    Loop
    End Sub[/VBA]
    [VBA]Private Sub cond_copy()
    'procedure to copy rows based on criteria
    Dim rOWCOUNT, r, lr As Long
    Dim cell As Range
    Dim V1, V2 As Variant

    'assuming the data is in sheet1
    Sheets("8100Loop").Activate
    'Count number of rows in 8100Loop Sheet
    rOWCOUNT = Range("H" & Rows.Count).End(xlUp).Row
    For Each cell In Range("H1:H" & rOWCOUNT)
    'Current row number
    r = cell.Row

    'Lower Bound of Street Number
    V1 = Range("D" & r).Value
    'Upper Bound of Street Number
    V2 = Range("E" & r).Value

    'Checks match for street name and type, then if the street number is between V1 and V2
    '"And" conditions removes need for second loop
    If cell.Text = usrInputStreetName And cell.Offset(0, 1).Text = usrInputStreetType And _
    ((usrInputStreetNumber >= V1 And usrInputStreetNumber <= V2) Or _
    (usrInputStreetNumber <= V1 And usrInputStreetNumber >= V2)) Then

    'Find First empty row of destination sheet
    lr = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row + 1
    'Copy matching line to first empty row of destination sheet
    Range("A" & r & ":M" & r).Copy Destination:=Sheets("Sheet2").Range("A" & lr)
    End If
    Next

    End Sub[/VBA]

    Tell me if this gets you close to what you want
    Attached Files Attached Files
    ------------------------------------------------
    Happy Coding my friends

  15. #15
    You have the right idea now. I tried it out but it did not copy the row onto sheet 2. The olny thing that the main sub did was ask the user for values. Is there something that needs to be rearranged? Maybe the cond_copy sub is not being called.

  16. #16
    VBAX Expert CatDaddy's Avatar
    Joined
    Jun 2011
    Posts
    581
    Location
    was your input criteria a match?
    ------------------------------------------------
    Happy Coding my friends

  17. #17
    I input 2 Plumb Ln and nothing happened

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •