PDA

View Full Version : VBA coding help



fastlanenate
08-21-2012, 08:55 AM
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.
:banghead:


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

CatDaddy
08-21-2012, 09:01 AM
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
'It sets your code apart and makes it easier to read

fastlanenate
08-21-2012, 10:04 AM
dropbox.com/s/2wpfxpynms8zexi/SampleWorkbook.xlsm

Here is a link to the sample work book

CatDaddy
08-21-2012, 10:31 AM
I cant get the link to work, if you go into the "Go Advanced" option you can attach the file to your post

fastlanenate
08-21-2012, 11:10 AM
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

CatDaddy
08-21-2012, 11:14 AM
i would like to see a mock up of your workbook and what you would like your output to look like

fastlanenate
08-21-2012, 11:14 AM
Here is the sample workbook. please use the code that i provided in the previous post. Thanks

fastlanenate
08-21-2012, 11:16 AM
I would like the output to highlight the row and delete the rest of the rows

CatDaddy
08-21-2012, 11:46 AM
'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

CatDaddy
08-21-2012, 12:14 PM
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

fastlanenate
08-21-2012, 01:43 PM
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

CatDaddy
08-21-2012, 02:07 PM
what are you generating the new unit number by? and you want the result on Sheet2?

fastlanenate
08-21-2012, 02:16 PM
The unit number is in column A on the "8100 Loop" sheet and Yes the result should be on page two please

CatDaddy
08-22-2012, 09:05 AM
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
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
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

Tell me if this gets you close to what you want

fastlanenate
08-22-2012, 12:07 PM
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.

CatDaddy
08-22-2012, 12:59 PM
was your input criteria a match?

fastlanenate
09-04-2012, 07:37 AM
I input 2 Plumb Ln and nothing happened