Populate LastCol +1 with Vlookup and other Functions

[exc4libur]

Hi,

I built the code below which calls my vlookup function and places the values automatically based on specified wks. It works like a charm!

*My problem: I have another wks "Sheet2" which I would like to *DIVIDE* by 100 the values from my Vlookup. So I have attached the workbook with my formula in excel and I have also inserted where I am having trouble in the macro!

 Sub Test1()

Dim ws As Worksheet
Dim lastCol As Long
Dim lastRow As Long

On Error Resume Next 'trap for data in "iv"

   For Each ws In ActiveWorkbook.Worksheets
      With ws
        .Activate
        lastCol = Range("IV2").End(xlToLeft).Column
        lastRow = Range("A65536").End(xlUp).Row
        
        'Determine Select Case
Select Case .Name
           Case "Sheet1":
                FullPath = ThisWorkbook.Path
                WbName = "Book1.xls"
                ShName = "Table1"
                SourceRng = "C1:C6"
                ReturnColNum = 3
                
            '************************
            'Case "Sheet2":
            'Divide values by 100 found from Vlookup Function
            'ie: ="(100/VLOOKUP(SrcValue;Table1,C1:C6,3,False))"
            'How can I add this??
            '*************************
        End Select
        
        ' Call Vlookup with Variables
        For rw = 2 To lastRow
             SrcValue = .Cells(rw, 1).Value
            .Cells(rw, lastCol + 1).Value = RemoteVlookUp(SrcValue, FullPath, WbName, ShName, SourceRng, ReturnColNum)
            Next rw
      End With
Next ws

End Sub

Private Function RemoteVlookUp(SrcValue, FullPath, WbName, ShName, SourceRng, ReturnColNum) As String
Dim ReturnedValue As String

' NOTE: error will occur even if value cannot be found and everything else is OK

On Error GoTo ErrHandler

   If Not Right(FullPath, 1) = "\" Then FullPath = FullPath & "\"

   ReturnedValue = ExecuteExcel4Macro("VLOOKUP(""" & SrcValue & _
   """,'" & FullPath & _
   "[" & WbName & "]" & _
   ShName & "'!" _
   & SourceRng & "," _
   & ReturnColNum & ",FALSE)")
   
   RemoteVlookUp = ReturnedValue
   Exit Function
ErrHandler:
   RemoteVlookUp = VlookupNA
End Function

 

[AlphaFrog]

Here's one way to do it based on your existing code...

        [COLOR="Green"]' Call Vlookup with Variables[/COLOR]
        For rw = 2 To lastRow
             SrcValue = .Cells(rw, 1).Value
            .Cells(rw, lastCol + 1).Value = RemoteVlookUp(SrcValue, FullPath, WbName, ShName, SourceRng, ReturnColNum)
            [COLOR="Red"]If ws.Name = "Sheet2" Then .Cells(rw, lastCol + 1).Value = .Cells(rw, lastCol + 1).Value / 100[/COLOR]
            Next rw

 

[exc4libur]

But what if I had 30 wks and I had to do:

Divide sheet2;sheet3;sheet4;sheet5

Sum sheet6;sheet7;sheet8;etc..

Multiply sheet10;""11;""12;...

 

[AlphaFrog]

Do all the sheets use the VLOOKUP formula and you want to Divide\Sum\Multiply specific sheets by some factor?

Or does each sheet have a unique formula which may be other than the VLOOKUP?

 

[exc4libur]

Do all the sheets use the VLOOKUP formula and you want to Divide\Sum\Multiply specific sheets by some factor?

Or does each sheet have a unique formula which may be other than the VLOOKUP?

Great question

For now all sheets are filled using vlookup;
However, in other workbooks I would love to use not only vlookup but other formulas for specific sheets in the wb!

 

[exc4libur]

Any ideas??

i tried attaching my test workbook with your bit of code *working fine!, but i am not finding the options to do so.. strange!

 

[AlphaFrog]

Try something like this...

Sub Test2()
    
    Dim ws As Worksheet
    Dim rng As Range
    Dim NextCol As Long
    Dim LastRow As Long
    
    Application.ScreenUpdating = False
    
    For Each ws In ActiveWorkbook.Worksheets
    
        With ws
        
            '.Activate
            NextCol = .Range("IV2").End(xlToLeft).Column + 1                 ' Next available column
            LastRow = .Range("A65536").End(xlUp).Row                         ' Last used row
            Set rng = .Range(.Cells(2, NextCol), .Cells(LastRow, NextCol))   ' Range for formulas
            
            ' Unique formulas for each sheet
            Select Case .Name
                
                Case "Sheet1", "Sheet4"
                    rng(1).Formula = _
                        "=VLOOKUP(A2,'" & ThisWorkbook.Path & "\[Book1.xls]Table1'!$C$1:$E$6,3,FALSE)"
                
                Case "Sheet2"
                    rng(1).Formula = _
                        "=VLOOKUP(A2,'" & ThisWorkbook.Path & "\[Book1.xls]Table1'!$C$1:$E$6,3,FALSE)/100"
                
                Case "Sheet3"
                    rng(1).Formula = _
                        "=VLOOKUP(A2,'" & ThisWorkbook.Path & "\[Book1.xls]Table1'!$C$1:$E$6,3,FALSE)*100"
            End Select
            
            rng(1).AutoFill Destination:=rng    ' Autofill formulas down the column
            rng.Value = rng.Value               ' Convert formulas to constants
            rng.Replace "#N/A", vbNullString    ' Clear #N/A errors
            
        End With
           
    Next ws
    
    Application.ScreenUpdating = True
    
End Sub

 

[exc4libur]

Works like a charm, only one more thing:

     rng.Replace "#N/A", vbNullString    ' Clear #N/A errors

If error: can the i replace #n/a with the cell value on the left?

 

[AlphaFrog]

This uses the R1C1 reference style to facilitate referencing one cell to the left of each formula. Also, no need to autofill down with R1C1.

            ' Unique formulas for each sheet
            Select Case .Name
                
                Case "Sheet1", "Sheet4"
                    rng[COLOR="Red"].FormulaR1C1[/COLOR] = _
                        "=IF(ISERROR(VLOOKUP([COLOR="Red"]RC1[/COLOR],'" & ThisWorkbook.Path & "\[Book1.xls]Table1'![COLOR="Red"]R1C3:R6C5[/COLOR],3,FALSE))," & _
                         "[COLOR="Red"]RC[-1][/COLOR]," & _
                         "VLOOKUP([COLOR="Red"]RC1[/COLOR],'" & ThisWorkbook.Path & "\[Book1.xls]Table1'![COLOR="Red"]R1C3:R6C5[/COLOR],3,FALSE))"
                
                Case "Sheet2"
                    rng.FormulaR1C1 = _
                        "=IF(ISERROR(VLOOKUP(RC1,'" & ThisWorkbook.Path & "\[Book1.xls]Table1'!R1C3:R6C5,3,FALSE))," & _
                         "RC[-1]," & _
                         "VLOOKUP(RC1,'" & ThisWorkbook.Path & "\[Book1.xls]Table1'!R1C3:R6C5,3,FALSE)/100)"
                
                Case "Sheet3"
                    rng.FormulaR1C1 = _
                        "=IF(ISERROR(VLOOKUP(RC1,'" & ThisWorkbook.Path & "\[Book1.xls]Table1'!R1C3:R6C5,3,FALSE))," & _
                         "RC[-1]," & _
                         "VLOOKUP(RC1,'" & ThisWorkbook.Path & "\[Book1.xls]Table1'!R1C3:R6C5,3,FALSE)*100)"
            End Select
            
            [COLOR="Green"]'rng(1).AutoFill Destination:=rng    ' Autofill formulas down the column[/COLOR]
            rng.Value = rng.Value               [COLOR="Green"]' Convert formulas to constants[/COLOR]
            [COLOR="Green"]'rng.Replace "#N/A", vbNullString    ' Clear #N/A errors[/COLOR]
            
        End With

 

[exc4libur]

Ok ok i did r1c1 before, but i thought it the code would be too messy..

Either way, thank you for you help and time man!
Really appreciate the attention!

Best Rgds,
Exc4