Consulting

Results 1 to 2 of 2

Thread: Changing Vlookup to variable depending on search results? idk

  1. #1

    Changing Vlookup to variable depending on search results? idk

    Hello All

    Currently I have a macro that moves previous day remarks to current days report.
    It is based of the assumption that the key number will always be in column
    "C". How can I make it so that it do it no mater what column that key number is in?
    Sub Get_oData()
    
    
    Dim strrow As Integer 'Hold current row numner
    Dim cntr As Integer 'hold true (1) or false(0)
    Dim wb As Workbook
    Dim p_day As String
    Dim cBook As String 'current (newly downloaded) report
    Dim nBook As String 'Prior report
    Dim mBook As String 'Macro book
    Dim ws As Integer 'Worksheet
    
    
    Dim strCrow As Integer ' Hold the header row number for current(newly downloaded) report
    Dim strLrowC As Integer ' Hold the last row number for current(newly downloaded) report
    Dim strAWBcolC As String ' Hold the AWB column, coverted to letter for current(newly downloaded) report
    Dim strRemarkcolC As String ' Hold the Advisor's Remarks column, coverted to letter for current(newly downloaded) report
    
    
    Dim strCounter As Integer ' Hold the worksheet count
    Dim strNrow As Integer ' Hold the header row number for prior report
    Dim strLrowN As Integer ' Hold the last row number for prior report
    Dim strAWBcolN As String ' Hold the AWB column, coverted to letter for prior report
    Dim strRemarkcolN As String ' Hold the Advisor's Remarks column, coverted to letter for prior report
    
    
    
    
        mBook = ActiveWorkbook.Name
    
    
        MsgBox "Please select the Number of the newly downloaded sheet."
    GetXLApp
        
        cBook = ActiveWorkbook.Name
        
        Range("A1").Select
    ' locate the header row of the current downloaded sheet
        Do While cntr = 0
            strrow = ActiveCell.Row
            strCrow = WorksheetFunction.CountA(ActiveSheet.Range(strrow & ":" & strrow))
            If strCrow < 5 Then
                ActiveCell(2, 1).Select
            End If
            If Len(Range("D" & strrow)) <= 2 And ActiveCell.Row <= strrow Then
                ActiveCell(2, 1).Select
            End If
            If strCrow > 5 Then
                If Len(Range("D" & strrow)) > 2 Then
                    cntr = 1
                End If
            Else
                cntr = 0
            End If
        Loop
        strLrowC = ActiveSheet.UsedRange.Rows.Count
        strCrow = ActiveCell.Row
        strRemarkcolC = WorksheetFunction.VLookup(WorksheetFunction.Match("Advisor's Remarks", Range(strCrow & ":" & strCrow), 0), Workbooks(mBook).Sheets("Table").Range("B:C"), 2, False)
        strAWBcolC = WorksheetFunction.VLookup(WorksheetFunction.Match("AWB Number", ActiveSheet.Range(strCrow & ":" & strCrow), 0), Workbooks(mBook).Sheets("Table").Range("B:C"), 2, False)
            
    ' go get the prior report used to get the comments from
        
     Application.ScreenUpdating = False
    
    
        MsgBox "Please select the location of your Last Report."
            With Application.FileDialog(msoFileDialogOpen)
            .Show
            If .SelectedItems.Count = 1 Then
                Path = .SelectedItems(1)
            End If
            
        End With
    
    
        If Path = "" Then
            MsgBox "Action Cancelled, program will end"
            Exit Sub 'Hard Coded Path
        Else
           ' user input path
        End If
        
        Workbooks.Open Filename:=Path
        
        cntr = 0
        strrow = 0
        nBook = ActiveWorkbook.Name
        strCounter = ActiveWorkbook.Worksheets.Count
        
        For ws = 1 To strCounter
        Sheets(ws).Select
        
        Range("A1").Select
    ' locate the header row of the current downloaded sheet
        Do While cntr = 0
            strrow = ActiveCell.Row
            strNrow = WorksheetFunction.CountA(ActiveSheet.Range(strrow & ":" & strrow))
            If strCrow < 5 Then
                ActiveCell(2, 1).Select
            End If
            If Len(Range("D" & strrow)) <= 2 And ActiveCell.Row <= strrow Then
                ActiveCell(2, 1).Select
            End If
            If strCrow > 5 Then
                If Len(Range("D" & strrow)) > 2 Then
                    cntr = 1
                End If
            Else
                cntr = 0
            End If
        Loop
        strLrowN = ActiveSheet.UsedRange.Rows.Count
        strNrow = ActiveCell.Row
        strRemarkcolN = WorksheetFunction.VLookup(WorksheetFunction.Match("Advisor's Remarks", Range(strNrow & ":" & strNrow), 0), Workbooks(mBook).Sheets("Table").Range("B:C"), 2, False)
        strAWBcolN = WorksheetFunction.VLookup(WorksheetFunction.Match("AWB Number", ActiveSheet.Range(strNrow & ":" & strNrow), 0), Workbooks(mBook).Sheets("Table").Range("B:C"), 2, False)
          
        
        Workbooks(cBook).Activate
    
    
        Range(strRemarkcolC & strCrow).Select
        strrow = ActiveCell.Row
        Do While ActiveCell.Row < strLrowC
        On Error Resume Next
            check = WorksheetFunction.Match("Advisor's Remarks", Workbooks(nBook).Sheets("Sheet1").Range(strNrow & ":" & strNrow), 0) - 2
            ActiveCell(2, 1).Select
            strrow = strrow + 1
            ActiveCell = WorksheetFunction.VLookup(ActiveSheet.Range(strAWBcolC & strrow), Workbooks(nBook).Sheets(ws).Range(strAWBcolN & strNrow & ":" & strRemarkcolN & strLrowN) _
                , WorksheetFunction.Match("Advisor's Remarks", Workbooks(nBook).Sheets(ws).Range(strNrow & ":" & strNrow), 0) - 2, False)
            
        Loop
         Windows(nBook).Activate
         
        Next ws
        
        Workbooks(nBook).Close
        
        MsgBox "Comments have been added."
        
     Application.ScreenUpdating = True
     
    End Sub

    Sub test()
    
    
    Dim strC As Integer
    
    
    strC = WorksheetFunction.CountA(ActiveSheet.Range(Cells.Row & ":" & Cells.Row))
    
    
    If strC = 1 Then
        Exit Sub
    End If
    End Sub
    Thanks in advance
    Last edited by Paul_Hossler; 12-04-2017 at 06:00 PM.

  2. #2
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    Welcome to the forum

    I added CODE tags around your macros - you can use the [#] icon to add them yourself next time

    My sig also has some tips

    Without knowing more about your workbook, I can't suggest anything very useful. Attach a sample XLSM will make it easer to offer some suggestions
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

Tags for this Thread

Posting Permissions

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