VBA Excel Help

[jamesbeat64]

Hello Forum Members,

I am fairly new to programming in general and am just learning VBA for Excel and Access. I currently have a work project that involves producing a SQL query from our internal database system based on VBA procedures in an Excel template. Most of the code was built previously and I am trying to add a feature to allow data typed into a cell added in a separate column based on data typed in an adjacent cell. Should I create a new procedure to declare variables and how would I allow for the new data to tie to the cell #1 data?

Thanks,

James B

[adam_k]

Since you are trying to add something to an existing program, my advise is to continue with the same philosophy that the program was written in the first place.
With that in mind, how you'll handle the cell you are trying to add depends as to how the initial programmer created the query.
A copy of the code that you are trying to work with and specifics on the cell and the condition you are trying to implement would tell us how to further assist you.

[jamesbeat64]

This code was created to generate what is called a Direct Dial number for emergency 911 call centers. It's an administrative line. At my job, we use a series of databases to house this information. What I am trying to do is upgrade this code to include a field in the final excel report that lists the old direct dial number alongside the corresponding ID number for the 911 center aka PSAP ID. Ideally, I would like to have the user enter the old direct dial number in the adjacent cell to the PSAP ID. The SQL code queries our internal database to provide all necessary data based on this PSAP ID.

Sub DirectDialSSKit()

    Dim cn As ADODB.Connection
    Dim rsRecords As ADODB.Recordset
    Dim c As ADODB.Connection
    Dim r As ADODB.Recordset

    Dim sqlstring, sqlstring1 As String
    Dim RowCount, currentRow, RowIndex As Integer
    Dim arrayPSAPID() As String
    Dim sqlPSAPID, sqlPSAPID1 As String
    Dim LPRow As Integer
    Dim CRow As Integer
    Dim PStatusEnforce As String
    Dim PPhaseEnforce As String
    Dim LRow As Integer

    Application.ScreenUpdating = False

    sqlPSAPID = ""
    sqlPSAPID1 = ""
    RowCount = TotalRowCount

'Get each PSAPID into an array and generate the SQL Where OR Statement for querying Remedy
    ReDim arrayPSAPID(0 To RowCount - 2) As String

    For currentRow = 2 To RowCount

        RowIndex = currentRow - 2
        arrayPSAPID(RowIndex) = Trim(Cells(currentRow, 1).Value)
        sqlPSAPID = sqlPSAPID & " OR P.AA_PSAPID = '" & arrayPSAPID(RowIndex) & "'"

    Next

    sqlPSAPID = Right(sqlPSAPID, Len(sqlPSAPID) - 3)

'1/29: PSAPID field name is diff in Remedy vs Deployment Web, therefore different SQL
    ReDim arrayPSAPID(0 To RowCount - 2) As String

        For currentRow = 2 To RowCount

        RowIndex = currentRow - 2
        arrayPSAPID(RowIndex) = Cells(currentRow, 1).Value
        sqlPSAPID1 = sqlPSAPID1 & " OR PSAPID = '" & arrayPSAPID(RowIndex) & "'"

    Next

    sqlPSAPID1 = Right(sqlPSAPID1, Len(sqlPSAPID1) - 3)

'Query Remedy data
    Workbooks.Add
    Worksheets("Sheet2").Delete
    Worksheets("Sheet3").Delete

   ActiveSheet.Name = "Direct Dial Master List"

   sqlstring = "SELECT DISTINCT M.AA_Carrier||''||P.AA_PSAPID, M.AA_PointCode, P.AA_DDTELNUM, M.AA_CARRIER, C.AA_PointCode, M.Name, C.AA_MarketID, C.AA_DESCR, C.AA_CellSiteID, S.AA_SectorID," & _
                " S.AA_LATITUDE, S.AA_LONGITUDE, C.AA_STREET, C.AA_CITY, C.AA_STATE, C.AA_ZIP, S.AA_MSCID, S.AA_CellSiteSectorID, S.AA_ESRD, P.AA_PSAPNAME" & _
                " FROM (AA_PSAP P INNER JOIN AA_ESZ E ON P.AA_PSAPID = E.AA_PSAPID) INNER JOIN (AA_CELLSITESECTOR S INNER JOIN" & _
                " (AA_MSC M INNER JOIN AA_CELLSITE C ON M.AA_POINTCODE = C.AA_POINTCODE) ON (S.AA_POINTCODE = C.AA_POINTCODE) AND (S.AA_CellSiteID = C.AA_CellsiteID))" & _
                " ON E.AA_ESZID = S.AA_ESZID" & _
                " WHERE" & sqlPSAPID & _
                " GROUP BY M.AA_Carrier||''||P.AA_PSAPID, M.AA_PointCode, P.AA_DDTELNUM, M.AA_CARRIER, C.AA_PointCode, M.Name, C.AA_MarketID, C.AA_DESCR, C.AA_CellSiteID, S.AA_SectorID, S.AA_LATITUDE, S.AA_LONGITUDE, C.AA_STREET, C.AA_CITY," & _
                " C.AA_STATE, C.AA_ZIP, S.AA_MSCID, S.AA_CellSiteSectorID, S.AA_ESRD, P.AA_PSAPNAME" & _
                " ORDER BY M.AA_Carrier||''||P.AA_PSAPID, C.AA_PointCode, C.AA_CellSiteID, S.AA_SectorID, S.AA_ESRD "

    'ODBC Oracle
    Set cn = New ADODB.Connection
        cn = "DRIVER={ORACLE ODBC DRIVER};SERVER=;UID=;PWD=;DBQ=;"

    With cn
        .ConnectionString = conn
        .CursorLocation = adUseClient
        .Open
    End With

     Set rsRecords = cn.Execute(sqlstring)

     If rsRecords.RecordCount < 1 Then
        MsgBox "Cannot find record"
          GoTo eee
     Else

    'Parse data back to Excel with specific column title approved by stakeholders (except col A & B which is use for seperate files)
        Range("A1:W1").Value = Array("PtCodePSAPPhase", "CarrierPSAPCAT", "CarrierPSAPKey", "KeyIndex", "Direct Dial / Alt Routing #", "CARRIER ID", "POINTCODE", "MSC Name", "MARKET ID", "DESCR", "CELLSITE ID", "SECTOR ID", "LATITUDE", "LONGITUDE", "STREET", "CITY", "STATE", "ZIP", "MSC ID", "CELLSITESECTOR ID", "ESRD", "PSAP NAME", "PSAP Phase")
        Range("C2").CopyFromRecordset rsRecords
     End If


'Query Deployment Web data
     Worksheets.Add
     ActiveSheet.Name = "Phase"

    'Use If statement to convert NotLive PSAP to '0' and all Live to '1'
    sqlstring1 = "SELECT DISTINCT CONCAT(CarrierName, PSAPID), PHASE, IF(PHASE=0, 0, 1)" & _
                " FROM snap_psaplive" & _
                " WHERE" & sqlPSAPID1 & _
                " GROUP BY CONCAT(CarrierName, PSAPID), PHASE, IF(PHASE=0, 0, 1)"


    Set c = New ADODB.Connection

    c.Open "DRIVER={MySQL ODBC 3.51 Driver};SERVER=;DATABASE=;USER=;"

    'c.Open "DSN="

    Set r = c.Execute(sqlstring1)
        If r.EOF = False Then
            Range("A1:C1").Value = Array("CarrierPSAPKey", "Phase", "PSAPSTATUS")
            Range("A2").CopyFromRecordset r
        End If

    r.Close
    c.Close

    'Find the last row in Phase spreadsheet for the next set of code to use
    LPRow = Range("B65536").End(xlUp).Row

'Parse Phase, PSAPStatus data from Phase sheet to Direct Dial Master List
 Sheets("Direct Dial Master List").Select

 'Find the last row in Direct Dial Master List
 LRow = Range("C65536").End(xlUp).Row

 'Use vlookup to lookup Phase and Status value from phase and parse into Direct Dial Master list
 For CRow = 2 To LRow

    Range("B" & CRow).Formula = "=IF(ISNA(VLOOKUP($C" & CRow & ",Phase!$A$2:$C$" & LPRow & ",3,0)),0,VLOOKUP($C2,Phase!$A$2:$C$" & LPRow & ",3,0))"
    Range("W" & CRow).Formula = "=IF(ISNA(VLOOKUP($C" & CRow & ",Phase!$A$2:$C$" & LPRow & ",2,0)),0,VLOOKUP($C2,Phase!$A$2:$C$" & LPRow & ",2,0))"
    Range("A" & CRow).Value = Range("B" & CRow).Value & "_" & Range("D" & CRow).Value

 Next

 'Copy and paste value into static value, later on master columns will get delete
 Range("A1:W" & CRow).Select
 Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

'Delete Col B to D as they no longer needed
Columns("B:D").Select
Selection.Delete Shift:=xlToLeft

    Call SaveEachPtCodeIntoWS

    Call SaveIntoNewWorkbooks

    Application.ScreenUpdating = True

eee: End Sub
Function TotalRowCount() As Integer

'Count how many PSAPIDs in the current workbook

Dim rRange As Range

    Set rRange = Columns("A:A")
    TotalRowCount = Application.WorksheetFunction.CountA(rRange)

End Function

Function SaveEachPtCodeIntoWS()

Dim rRange As Range, rCell As Range
Dim wSheet As Worksheet
Dim wSheetStart As Worksheet
Dim strText As String
Dim i As Integer
Dim tSheets As Integer

    Set wSheetStart = ActiveSheet
    wSheetStart.AutoFilterMode = False
    'Set a range variable to the correct item column
    Set rRange = Range("A1", Range("A65536").End(xlUp))

    'Delete any sheet called "UniqueVal"
    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets("UniqueVal").Delete

'Add a sheet called "UniqueVal" which shows the unique values of the PSAPID
        Worksheets.Add().Name = "UniqueVal"

           'Filter the Set range so only a unique list is created
            With Worksheets("UniqueVal")
                rRange.AdvancedFilter xlFilterCopy, , _
                 Worksheets("UniqueVal").Range("A1"), True

                 'Set a range variable to the no duplicate, less the heading.
                 Set rRange = .Range("A2", .Range("A65536").End(xlUp))
            End With

            On Error Resume Next
            With wSheetStart
                For Each rCell In rRange
                  strText = rCell
                 .Range("A1").AutoFilter 1, strText
                    Worksheets(strText).Delete
                    'Add a set named as content of rCell

                   Worksheets.Add().Name = strText
                    .UsedRange.Copy Destination:=ActiveSheet.Range("A1")
                    ActiveSheet.Cells.Columns.AutoFit
                    Columns("A:A").Select
                    Selection.Delete Shift:=xlToLeft
                    Range("A1").Select

                Next rCell

            End With

        With wSheetStart
            .AutoFilterMode = False
            .Activate
        End With

        Worksheets("UniqueVal").Delete
       Worksheets("Phase").Delete

        On Error GoTo 0
        Application.DisplayAlerts = True


End Function

Function SaveIntoNewWorkbooks()

Dim wbDest As Workbook
Dim wbSource As Workbook
Dim sht As Object
Dim strSavePath As String
Dim Carrier As String
Dim SwitchName As String
Dim CRQNum As String
Dim username As String
Dim FileDate As String

    CRQNum = InputBox("Enter CRQ Number:", "Input CRQ Number")

    username = Environ("UserName")
    FileDate = Format(Now(), "mm-dd-yy")
    strSavePath = "C:\Documents and Settings\" & username & "\My Documents\" 'Change this to suit your needs

    Set wbSource = ActiveWorkbook

    For Each sht In wbSource.Sheets
        sht.Copy
        Set wbDest = ActiveWorkbook
        Carrier = Range("B2").Value
        SwitchName = Range("D2").Value
        wbDest.SaveAs strSavePath & CRQNum & "_" & Carrier & "_" & sht.Name & "_" & SwitchName & "_" & FileDate & ".xlsx"
    Next

ActiveWorkbook.Close

End Function

[adam_k]

1st of all, what sheet are we talking about and
2nd do I understand correctly that users will type in the "old direct dial number" ? Doesn't this exist anywhere in your db?