none
Search and Print data in VBA RRS feed

  • Question

  • Hello

    i'm trying to build a code that opens a form in word to enter a reference number, and search this number in an excel sheet

    if the number is found, then it will print the name and organization value (which are belong to that reference number on the same row) in text box in word

    and then update the excel sheet in the same row of that reference number and insert the word (done) in a column

    this what I have so far,

    Public xlapp As Object
    Public xlbook As Object
    Public GuestCounter As Integer

    'for 64bit systems
    Private Declare PtrSafe Function ActivateKeyboardLayout Lib _
     "user32.dll" (ByVal myLanguage As Long, Flag As Boolean) As Long
      

     Private Sub Number_Change()
     
      Dim Refernce As Integer
      Set Reference = Number.Text
       
     End Sub

    Private Sub Print_Name_Click()
     
     Dim rToSearch As Range
        Dim rCl    As Range
       
       
        Set rToSearch = Worksheets(GuestList).Range(Cells(1, 6), Cells(Rows.Count, 6).End(xlUp))
         
        Set rCl = rToSearch.Find(sFind, LookIn:=xlValues)
         
        
        If  rCl = Reference
             'printing the label
    ActiveDocument.Shapes(1).TextFrame.TextRange.Text = vbCrLf & GuestName.Value & vbCrLf & Organization.Value
    ActiveDocument.PrintOut Range:=wdPrintCurrentPage

    'updating excel
    GuestCounter = GuestCounter + 1
    Dim newRecRow As Integer
    newRecRow = GuestCounter + 3
    xlWB.Sheets(1).Cells(newRecRow, 7) = "Done"
        Else
    MsgBox sFind & "Not found"
       
     
        End If

        
    End Sub



    Private Sub UserForm_Initialize()
        Dim currDir As String
        currDir = ThisDocument.Path
        
        Set xlWB = xlapp.Workbooks.Open(currDir & "\" & "GuestList.xlsx")
       
        Set xlapp = CreateObject("Excel.Application")
        GuestCounter = CInt(xlWB.Sheets(1).Cells(1, 1))
      
    End Sub

    Private Sub UserForm_Terminate()
        xlWB.Save
        xlWB.Close
        xlapp.Quit ' close the Excel application
        Set xlWB = Nothing
        Set xlapp = Nothing
    End Sub



    Thursday, January 21, 2016 8:15 AM

Answers

  • Try something based on:

    Option Explicit
    Dim xlApp As Object, xlWkBk As Object, xlWkSht As Object, xlRng As Object, lRow As Long
    Dim bStrt As Boolean, bOpen As Boolean
    Dim StrTxt As String, StrWkBkNm As String, StrFnd As String
    'Excel worksheet name
    Const StrWkSht As String = "GuestList"

    Private Sub UserForm_Initialize()
    'Excel workbook name & path
    StrWkBkNm = CurDir & "\" & "GuestList.xlsx"
    If Dir(StrWkBkNm) = "" Then
      MsgBox "Cannot find the designated workbook: " & StrWkBkNm, vbExclamation
      Call UserForm_Terminate
    End If
    bStrt = False ' Flag to record if we start Excel, so we can close it later.
    bOpen = False ' Flag to record if we open the workbook, so we can close it later.
    ' Test whether Excel is already running.
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    'Start Excel if it isn't running
    If xlApp Is Nothing Then
      Set xlApp = CreateObject("Excel.Application")
      If xlApp Is Nothing Then
        MsgBox "Can't start Excel.", vbExclamation
        Call UserForm_Terminate
      End If
      ' Record that we've started Excel.
      bStrt = True
    End If
    On Error GoTo 0
    With xlApp
      'Hide our Excel session if we started it
      If bStrt = True Then .Visible = False
      'Check if the workbook is open.
      For Each xlWkBk In .Workbooks
        If xlWkBk.FullName = StrWkBkNm Then ' It's open
          Set xlWkBk = xlWkBk
          bOpen = True
          Exit For
        End If
      Next
      ' If not open by the current user.
      If bOpen = False Then
        ' Check if another user has it open.
        If IsFileLocked(StrWkBkNm) = True Then
          ' Report and exit if true
          MsgBox "The Excel workbook is in use." & vbCr & "Please try again later.", vbExclamation, "File in use"
          Call UserForm_Terminate
        End If
        ' The file is available, so open it.
        Set xlWkBk = .Workbooks.Open(FileName:=StrWkBkNm)
        If xlWkBk Is Nothing Then
          MsgBox "Cannot open:" & vbCr & StrWkBkNm, vbExclamation
          Call UserForm_Terminate
        End If
      End If
      On Error Resume Next
      Set xlWkSht = xlWkBk.Sheets(StrWkSht)
      On Error GoTo 0
      If xlWkSht Is Nothing Then
        MsgBox "Cannot find the worksheet named: '" & StrWkSht & "' in:" & vbCr & StrWkBkNm, vbExclamation
        Call UserForm_Terminate
      End If
    End With
    Exit Sub
    End Sub

    Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    'Excel constant for use with late binding
    Const xlCellTypeLastCell As Long = 11
    'Value to Find in Excel
    StrFnd = Me.TextBox1.Text
    With xlWkSht
      lRow = .UsedRange.Cells.SpecialCells(xlCellTypeLastCell).Row
      Set xlRng = .Range("F1:F" & lRow).Find(What:=StrFnd, After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False)
      If Not xlRng Is Nothing Then
        .Cells(xlRng.Row, 7).Value = "Done"
        xlWkBk.Save
        With ActiveDocument
          .Shapes(1).TextFrame.TextRange.Text = vbCr & xlWkSht.Cells(xlRng.Row, 1).Value & vbCr & _
            xlWkSht.Cells(xlRng.Row, 2).Value
            xlWkBk.Sheets(1).Range("A1").Value = xlWkBk.Sheets(1).Range("A1").Value + 1
          .PrintOut Range:=wdPrintCurrentPage
        End With
      Else
        MsgBox StrFnd & " Not found"
      End If
    End With
    Application.ScreenUpdating = True
    End Sub

    Private Sub UserForm_Terminate()
    If Not xlWkBk Is Nothing Then If bOpen = False Then xlWkBk.Close
    If Not xlApp Is Nothing Then If bStrt = True Then xlApp.Quit
    Set xlRng = Nothing: Set xlWkSht = Nothing: Set xlWkBk = Nothing: Set xlApp = Nothing
    Unload UserForm1
    End Sub

    Function IsFileLocked(strFileName As String) As Boolean
      On Error Resume Next
      Open strFileName For Binary Access Read Write Lock Read Write As #1
      Close #1
      IsFileLocked = Err.Number
      Err.Clear
    End Function

    There are some ambiguities about your code. For example, it's not clear what the worksheet's name is. I've assumed it's 'GuestList', but you can change that on the line:
    Const StrWkSht As String = "GuestList"
    Elsewhere you refer to 'Sheets(1)' for the counter. If that is the same worksheet as the GuestList sheet, you should change the references to 'xlWkBk.Sheets(1)' in the above code to 'xlWkSht'.


    Cheers
    Paul Edstein
    [MS MVP - Word]

    Monday, January 25, 2016 12:00 AM

All replies

  • Hi msayo,

    According to your description, we don’t know your issue. What’s the problem of you? Please provide the details of your issue.

    Regards

    Starain


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Friday, January 22, 2016 7:39 AM
    Moderator
  • the code that I provide is not working

    I'm trying to build a code where the user should enter a number in a form built in VBA word, then the number is searched in a column in excel sheet, if its found, then it should print the value in the same row for the other columns in the table (which are the name and organization)

    , also, it should enter the word "DONE" in the same row at the result column.

    Sunday, January 24, 2016 5:05 AM
  • Try something based on:

    Option Explicit
    Dim xlApp As Object, xlWkBk As Object, xlWkSht As Object, xlRng As Object, lRow As Long
    Dim bStrt As Boolean, bOpen As Boolean
    Dim StrTxt As String, StrWkBkNm As String, StrFnd As String
    'Excel worksheet name
    Const StrWkSht As String = "GuestList"

    Private Sub UserForm_Initialize()
    'Excel workbook name & path
    StrWkBkNm = CurDir & "\" & "GuestList.xlsx"
    If Dir(StrWkBkNm) = "" Then
      MsgBox "Cannot find the designated workbook: " & StrWkBkNm, vbExclamation
      Call UserForm_Terminate
    End If
    bStrt = False ' Flag to record if we start Excel, so we can close it later.
    bOpen = False ' Flag to record if we open the workbook, so we can close it later.
    ' Test whether Excel is already running.
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    'Start Excel if it isn't running
    If xlApp Is Nothing Then
      Set xlApp = CreateObject("Excel.Application")
      If xlApp Is Nothing Then
        MsgBox "Can't start Excel.", vbExclamation
        Call UserForm_Terminate
      End If
      ' Record that we've started Excel.
      bStrt = True
    End If
    On Error GoTo 0
    With xlApp
      'Hide our Excel session if we started it
      If bStrt = True Then .Visible = False
      'Check if the workbook is open.
      For Each xlWkBk In .Workbooks
        If xlWkBk.FullName = StrWkBkNm Then ' It's open
          Set xlWkBk = xlWkBk
          bOpen = True
          Exit For
        End If
      Next
      ' If not open by the current user.
      If bOpen = False Then
        ' Check if another user has it open.
        If IsFileLocked(StrWkBkNm) = True Then
          ' Report and exit if true
          MsgBox "The Excel workbook is in use." & vbCr & "Please try again later.", vbExclamation, "File in use"
          Call UserForm_Terminate
        End If
        ' The file is available, so open it.
        Set xlWkBk = .Workbooks.Open(FileName:=StrWkBkNm)
        If xlWkBk Is Nothing Then
          MsgBox "Cannot open:" & vbCr & StrWkBkNm, vbExclamation
          Call UserForm_Terminate
        End If
      End If
      On Error Resume Next
      Set xlWkSht = xlWkBk.Sheets(StrWkSht)
      On Error GoTo 0
      If xlWkSht Is Nothing Then
        MsgBox "Cannot find the worksheet named: '" & StrWkSht & "' in:" & vbCr & StrWkBkNm, vbExclamation
        Call UserForm_Terminate
      End If
    End With
    Exit Sub
    End Sub

    Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    'Excel constant for use with late binding
    Const xlCellTypeLastCell As Long = 11
    'Value to Find in Excel
    StrFnd = Me.TextBox1.Text
    With xlWkSht
      lRow = .UsedRange.Cells.SpecialCells(xlCellTypeLastCell).Row
      Set xlRng = .Range("F1:F" & lRow).Find(What:=StrFnd, After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False)
      If Not xlRng Is Nothing Then
        .Cells(xlRng.Row, 7).Value = "Done"
        xlWkBk.Save
        With ActiveDocument
          .Shapes(1).TextFrame.TextRange.Text = vbCr & xlWkSht.Cells(xlRng.Row, 1).Value & vbCr & _
            xlWkSht.Cells(xlRng.Row, 2).Value
            xlWkBk.Sheets(1).Range("A1").Value = xlWkBk.Sheets(1).Range("A1").Value + 1
          .PrintOut Range:=wdPrintCurrentPage
        End With
      Else
        MsgBox StrFnd & " Not found"
      End If
    End With
    Application.ScreenUpdating = True
    End Sub

    Private Sub UserForm_Terminate()
    If Not xlWkBk Is Nothing Then If bOpen = False Then xlWkBk.Close
    If Not xlApp Is Nothing Then If bStrt = True Then xlApp.Quit
    Set xlRng = Nothing: Set xlWkSht = Nothing: Set xlWkBk = Nothing: Set xlApp = Nothing
    Unload UserForm1
    End Sub

    Function IsFileLocked(strFileName As String) As Boolean
      On Error Resume Next
      Open strFileName For Binary Access Read Write Lock Read Write As #1
      Close #1
      IsFileLocked = Err.Number
      Err.Clear
    End Function

    There are some ambiguities about your code. For example, it's not clear what the worksheet's name is. I've assumed it's 'GuestList', but you can change that on the line:
    Const StrWkSht As String = "GuestList"
    Elsewhere you refer to 'Sheets(1)' for the counter. If that is the same worksheet as the GuestList sheet, you should change the references to 'xlWkBk.Sheets(1)' in the above code to 'xlWkSht'.


    Cheers
    Paul Edstein
    [MS MVP - Word]

    Monday, January 25, 2016 12:00 AM