Convert VLOOKUP Cell Value to a Value on a Separate Worksheet

[kaysee]

I use the following VLOOKUP formula to add up the membership subscription payments in monthly worksheets labelled Nov, Dec, Jan, Feb, Mar, Apr, May, Jun, Jul, Aug, Sep, Oct (a calendar year) in a ‘Members’ worksheet that shows who have paid their annual fee and also totals up monthly payments for that member from each of the monthly worksheets:

Name of Member	Subs Payment	Total Payments
Name 1	10.00	30.00
Name 2	10.00	20.00

<tbody>
</tbody>

=VLOOKUP(B28,Nov!D:Z,17,FALSE)+VLOOKUP(B28,Dec!D:Z,17,FALSE)+VLOOKUP(B28,Jan!D:Z,17,FALSE)+VLOOKUP(B28,Feb!D:Z,17,FALSE)+VLOOKUP(B28,Mar!D:Z,17,FALSE)+VLOOKUP(B28,Apr!D:Z,17,FALSE)+VLOOKUP(B28,May!D:Z,17,FALSE)+VLOOKUP(B28,Jun!D:Z,17,FALSE)+VLOOKUP(B28,Jul!D:Z,17,FALSE)+VLOOKUP(B28,Aug!D:Z,17,FALSE)+VLOOKUP(B28,Sep!D:Z,17,FALSE)+VLOOKUP(B28,Oct!D:Z,17,FALSE)




I have produced VBA code in an attempt to copy the ‘Name’ and ‘Subs Payment’ columns from the ‘Members’ table to a new ‘Bagman’ worksheet and divide it into 3 equal length side-by-side columns so that it fits on one A4 sheet. This is what I want to achieve:

Name	Subs		Name	Subs		Name	Subs
Name 1	10.00		Name 50	5.00		Name 100	10.00
Name 2	10.00		Name 51			Name 101

<tbody>
</tbody>

' Copy_"Members"_To_"Bagman" Macro


    Sheet27.Select ' Members sheet

    Range("C3", Range("B3").End(xlDown)).Select

    Selection.Copy

    Range("A1").Select

    Sheet14.Select ' Bagman sheet

    Columns("A:B").Select

    ActiveSheet.Paste

    Range("A1").Select

 
' Convert One Pair of Columns to Three (near) equal length Pairs of Columns

     Dim lngR As Long

    Dim lngC As Long

    Dim lngHeaderRow As Long

    Dim strCol As String

    lngHeaderRow = 1

    strCol = "A"
 

    With Sheet14 ' Bagman sheet

        lngR = .Cells(.Rows.Count, strCol).End(xlUp).Row - lngHeaderRow

        lngC = .Cells(lngHeaderRow, .Columns.Count).End(xlToLeft).CurrentRegion.Columns.Count

        'Copy headers

        .Cells(lngHeaderRow, strCol).Resize(1, lngC).Copy .Cells(lngHeaderRow, strCol).Offset(0, lngC + 1)

        .Cells(lngHeaderRow, strCol).Resize(1, lngC).Copy .Cells(lngHeaderRow, strCol).Offset(0, 2 * lngC + 2)

         'Move data

        .Cells(lngHeaderRow, strCol).Offset(1 + 2 * (lngR \ 3) + lngR Mod 3, 0).Resize(lngR \ 3, lngC).Cut .Cells(lngHeaderRow, strCol).Offset(1, 2 * lngC + 2)

        .Cells(lngHeaderRow, strCol).Offset(1 + lngR \ 3 + IIf(lngR Mod 3 >= 1, 1, 0), 0).Resize(lngR \ 3 + IIf(lngR Mod 3 >= 1, 1, 0), lngC).Cut .Cells(lngHeaderRow, strCol).Offset(1, lngC + 1)

    End With

     Cells.EntireColumn.AutoFit

However, when the VLOOPUP cell value is copied to this new “Bagman” worksheet the value is shown as #N/A.

Name	Subs		Name	Subs		Name	Subs
Name 1	#N/A		Name 50	#N/A		Name 100	#N/A
Name 2	#N/A		Name 51	#N/A		Name 101	#N/A

<tbody>
</tbody>

I can overcome this problem by manually placing a member's subscription value in the relevant cell of the ‘Members’ worksheet (i.e. a specific value not derived from VLOOKUP) but I want to do this using the VLOOKUP procedure to ensure accuracy.

How can I stop this #N/A error from happening? Is there a way to convert the VLOOKUP cell value to a pure number, either before transferring to the ‘Bagman’ worksheet or during the process of transferring the data? It would be helpful if I just needed to modify the above code.

 

[Fluff]

Hi, welcome to the board.
Try replacing the top part of your code with this

    With Sheet27 ' Members sheet
        .Range("C3", .Range("B3").End(xlDown)).Copy
        .Range("A1").Select
    End With
    With Sheet14 ' Bagman sheet
        .Range("A1").PasteSpecial xlValues
        .Range("A1").Select
    End With

This will copy the values, rather than the formulae.

 

[kaysee]

Thanks for your prompt response. I commented out my original code and added your code but I got a run time error. It was on the first

.Range ("A1") .Select

line for the Members sheet. That does not make sense to me as it got past the

.Range ("C3"), .Range ("B3") .End(xlDown)).Copy

line.

By the way, I tried to post a jpg image of the error but could not find a way of attaching a file. Is there a way to do so?

 

[Fluff]

Best bet is to remove that line & also the same line in with sheet14

        Sheet27.Range("C3", Sheet27.Range("B3").End(xlDown)).Copy
        Sheet14.Range("A1").PasteSpecial xlValues

You can only use select like that on the active sheet & I forgot to get rid of them.
This site does not allow people to upload files here. You would need to put them on a fileshare site & post a link

 

[kaysee]

Many thanks, that works! It did not transfer the format of the original data but I should be able to add code to format the data on the Bagman worksheet.

 

[Fluff]

Glad to help & thanks for the feedback.
If you add this as line 3 it should copy the format as well

    Sheet14.Range("A1").PasteSpecial xlFormats

 

[kaysee]

This appears to work - is that where you said it should be inserted?

    With Sheet27 ' Members sheet
        .Range("C3", .Range("B3").End(xlDown)).Copy
    End With
    
    With Sheet14 ' Bagman sheet
        .Range("A1").PasteSpecial xlValues
    
    Sheet14.Range("A1").PasteSpecial xlFormats
    
    End With

 

[Fluff]

Yes that's fine, but as it's inside the With statement, you could remove the Sheet14 & leave it as

    With Sheet14 ' Bagman sheet
        .Range("A1").PasteSpecial xlValues
        .Range("A1").PasteSpecial xlFormats
    End With

 

[kaysee]

Thanks a million - everything works fine. For the record, for others accessing this forum with a similar problem here is the full code:

Option Explicit

Sub Generate_Bagman_List()


' Application.ScreenUpdating = False ' prevent each change to sheet showing
'
' Clear_"Bagman"_Contents Macro
'
    Sheet14.Select ' Bagman sheet
    Columns("A:I").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select


' Copy_"Members"_To_"Bagman" Macro
'
'    Sheet27.Select ' Members sheet
'    Range("C3", Range("B3").End(xlDown)).Select
'    Selection.Copy
'    Range("A1").Select
'    Sheet14.Select ' Bagman sheet
'    Columns("A:B").Select
'    ActiveSheet.Paste
'    Range("A1").Select


    With Sheet27 ' Members sheet
        .Range("C3", .Range("B3").End(xlDown)).Copy
    End With
    
    With Sheet14 ' Bagman sheet
        .Range("A1").PasteSpecial xlValues
        .Range("A1").PasteSpecial xlFormats
    End With


    
' Convert One Pair of Columns to Three (near) equal length Pairs of Columns
    
    Dim lngR As Long
    Dim lngC As Long
    Dim lngHeaderRow As Long
    Dim strCol As String
    
    lngHeaderRow = 1
    strCol = "A"
    
    With Sheet14 ' Bagman sheet
        lngR = .Cells(.Rows.Count, strCol).End(xlUp).Row - lngHeaderRow
        lngC = .Cells(lngHeaderRow, .Columns.Count).End(xlToLeft).CurrentRegion.Columns.Count
        'Copy headers
        .Cells(lngHeaderRow, strCol).Resize(1, lngC).Copy .Cells(lngHeaderRow, strCol).Offset(0, lngC + 1)
        .Cells(lngHeaderRow, strCol).Resize(1, lngC).Copy .Cells(lngHeaderRow, strCol).Offset(0, 2 * lngC + 2)
        'Move data
        .Cells(lngHeaderRow, strCol).Offset(1 + 2 * (lngR \ 3) + lngR Mod 3, 0).Resize(lngR \ 3, lngC).Cut .Cells(lngHeaderRow, strCol).Offset(1, 2 * lngC + 2)
        .Cells(lngHeaderRow, strCol).Offset(1 + lngR \ 3 + IIf(lngR Mod 3 >= 1, 1, 0), 0).Resize(lngR \ 3 + IIf(lngR Mod 3 >= 1, 1, 0), lngC).Cut .Cells(lngHeaderRow, strCol).Offset(1, lngC + 1)
    End With
    Cells.EntireColumn.AutoFit
   Range("G1").Select
FormulaR1C1 = "Vets membership showing who has paid 2017 subs (bagman to collect £10 subs from those who have not paid)."
    
    Range("A1").Select
    
Application.ScreenUpdating = True ' restore each change to sheet showing


End Sub

 

[Fluff]

Glad to help & thanks for the feedback