Results 1 to 8 of 8
  1. #1
    2 Star Lounger
    Join Date
    Apr 2001
    Location
    Vancouver, Canada
    Posts
    131
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Macro to paste fields from two lists into a sheet

    Hello,

    I have a macro that reads an item (department number) from a list, pastes it into a department cell on my spreadsheet, recalulates the spreadsheet and then prints it. The macro loops until it has completed these steps for all departments in the list.

    I need to change the macro so that it not only pastes the department number into the spreadsheet but it also pastes the department name into another cell in the spreadsheet. The original macro and my attempt at the change follow.

    Thanks in advance for any help you can provide.

    THIS IS WHAT MY LIST LOOKS LIKE:
    '0000 Balance Sheet
    '0010 Corporate
    '0015 Facility (Building)
    '0020 Finance
    '0023 Credit
    '0025 Information Systems
    '0030 Product Development
    '0033 Apparel Development
    '0035 Design
    '0040 Marketing
    '0043 Product Marketing Apparel
    '0045 Product Marketing Footwear
    '0050 Non-Europe
    '0052 Europe
    '0060 US Sales
    '0062 Outlet - Bothell
    '0065 Apparel
    '0070 Operations
    '0075 Customer Service
    '0090 Warehouse
    '0095 Far East

    The first column is the "SegmentValues" in the macro, the second column is "SegmentDesc" in my attempt

    ORIGINAL MACRO:
    Sub RunF9Report()
    Dim Position As Integer
    Application.ScreenUpdating = False
    Worksheets("Lists").Select
    Range("SegmentValues").Select
    SegmentValues = ActiveCell.Value
    Position = 1
    Do Until SegmentValues = ""
    Selection.Copy
    Worksheets("Brooks").Select
    Range("SegmentTarget").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    Range("ReportArea").Select
    Selection.Calculate
    Application.ExecuteExcel4Macro "ZeroSuppress()"
    Application.Goto Reference:="ReportArea"
    ActiveWindow.SelectedSheets.PrintOut Copies:=1
    Worksheets("Lists").Select
    Range("SegmentValues").Select
    ActiveCell.Offset(Position, 0).Select
    Position = Position + 1
    SegmentValues = ActiveCell.Value
    Loop
    End Sub

    MY ATTEMPT TO PASTE IN THE DEPARTMENT NAME:
    Sub RunF9Report()
    Dim Position As Integer
    Application.ScreenUpdating = False
    Worksheets("Lists").Select
    Range("SegmentValues").Select
    SegmentValues = ActiveCell.Value
    Position = 1
    Do Until SegmentValues = ""
    Selection.Copy
    Worksheets("Brooks").Select
    Range("SegmentTarget").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    If Range("SegmentTarget") = "'0000" Then
    Worksheets("Lists").Select
    Range("SegmentDesc").Select
    SegmentDesc = ActiveCell.Value
    Position = 1
    Selection.Copy
    Worksheets("Brooks").Select
    Range("DeptDesc").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    End If
    If Range("SegmentTarget") = "'0010" Then
    Worksheets("Lists").Select
    Range("SegmentDesc").Select
    SegmentDesc = ActiveCell.Value
    Position = 2
    Selection.Copy
    Worksheets("Brooks").Select
    Range("DeptDesc").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    End If
    If Range("SegmentTarget") = "'0015" Then
    Worksheets("Lists").Select
    Range("SegmentDesc").Select
    SegmentDesc = ActiveCell.Value
    Position = 3
    Selection.Copy
    Worksheets("Brooks").Select
    Range("DeptDesc").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    End If
    If Range("SegmentTarget") = "'0020" Then
    Worksheets("Lists").Select
    Range("SegmentDesc").Select
    SegmentDesc = ActiveCell.Value
    Position = 4
    Selection.Copy
    Worksheets("Brooks").Select
    Range("DeptDesc").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    End If
    If Range("SegmentTarget") = "'0023" Then
    Worksheets("Lists").Select
    Range("SegmentDesc").Select
    SegmentDesc = ActiveCell.Value
    Position = 5
    Selection.Copy
    Worksheets("Brooks").Select
    Range("DeptDesc").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    End If
    If Range("SegmentTarget") = "'0025" Then
    Worksheets("Lists").Select
    Range("SegmentDesc").Select
    SegmentDesc = ActiveCell.Value
    Position = 6
    Selection.Copy
    Worksheets("Brooks").Select
    Range("DeptDesc").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    End If
    If Range("SegmentTarget") = "'0030" Then
    Worksheets("Lists").Select
    Range("SegmentDesc").Select
    SegmentDesc = ActiveCell.Value
    Position = 7
    Selection.Copy
    Worksheets("Brooks").Select
    Range("DeptDesc").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    End If
    If Range("SegmentTarget") = "'0033" Then
    Worksheets("Lists").Select
    Range("SegmentDesc").Select
    SegmentDesc = ActiveCell.Value
    Position = 8
    Selection.Copy
    Worksheets("Brooks").Select
    Range("DeptDesc").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    End If
    If Range("SegmentTarget") = "'0035" Then
    Worksheets("Lists").Select
    Range("SegmentDesc").Select
    SegmentDesc = ActiveCell.Value
    Position = 9
    Selection.Copy
    Worksheets("Brooks").Select
    Range("DeptDesc").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    End If
    If Range("SegmentTarget") = "'0040" Then
    Worksheets("Lists").Select
    Range("SegmentDesc").Select
    SegmentDesc = ActiveCell.Value
    Position = 10
    Selection.Copy
    Worksheets("Brooks").Select
    Range("DeptDesc").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    End If
    If Range("SegmentTarget") = "'0043" Then
    Worksheets("Lists").Select
    Range("SegmentDesc").Select
    SegmentDesc = ActiveCell.Value
    Position = 11
    Selection.Copy
    Worksheets("Brooks").Select
    Range("DeptDesc").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    End If
    If Range("SegmentTarget") = "'0045" Then
    Worksheets("Lists").Select
    Range("SegmentDesc").Select
    SegmentDesc = ActiveCell.Value
    Position = 12
    Selection.Copy
    Worksheets("Brooks").Select
    Range("DeptDesc").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    End If
    If Range("SegmentTarget") = "'0050" Then
    Worksheets("Lists").Select
    Range("SegmentDesc").Select
    SegmentDesc = ActiveCell.Value
    Position = 13
    Selection.Copy
    Worksheets("Brooks").Select
    Range("DeptDesc").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    End If
    If Range("SegmentTarget") = "'0052" Then
    Worksheets("Lists").Select
    Range("SegmentDesc").Select
    SegmentDesc = ActiveCell.Value
    Position = 14
    Selection.Copy
    Worksheets("Brooks").Select
    Range("DeptDesc").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    End If
    If Range("SegmentTarget") = "'0060" Then
    Worksheets("Lists").Select
    Range("SegmentDesc").Select
    SegmentDesc = ActiveCell.Value
    Position = 15
    Selection.Copy
    Worksheets("Brooks").Select
    Range("DeptDesc").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    End If
    If Range("SegmentTarget") = "'0062" Then
    Worksheets("Lists").Select
    Range("SegmentDesc").Select
    SegmentDesc = ActiveCell.Value
    Position = 16
    Selection.Copy
    Worksheets("Brooks").Select
    Range("DeptDesc").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    End If
    If Range("SegmentTarget") = "'0065" Then
    Worksheets("Lists").Select
    Range("SegmentDesc").Select
    SegmentDesc = ActiveCell.Value
    Position = 17
    Selection.Copy
    Worksheets("Brooks").Select
    Range("DeptDesc").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    End If
    If Range("SegmentTarget") = "'0070" Then
    Worksheets("Lists").Select
    Range("SegmentDesc").Select
    SegmentDesc = ActiveCell.Value
    Position = 18
    Selection.Copy
    Worksheets("Brooks").Select
    Range("DeptDesc").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    End If
    If Range("SegmentTarget") = "'0075" Then
    Worksheets("Lists").Select
    Range("SegmentDesc").Select
    SegmentDesc = ActiveCell.Value
    Position = 19
    Selection.Copy
    Worksheets("Brooks").Select
    Range("DeptDesc").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    End If
    If Range("SegmentTarget") = "'0090" Then
    Worksheets("Lists").Select
    Range("SegmentDesc").Select
    SegmentDesc = ActiveCell.Value
    Position = 20
    Selection.Copy
    Worksheets("Brooks").Select
    Range("DeptDesc").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    End If
    If Range("SegmentTarget") = "'0095" Then
    Worksheets("Lists").Select
    Range("SegmentDesc").Select
    SegmentDesc = ActiveCell.Value
    Position = 21
    Selection.Copy
    Worksheets("Brooks").Select
    Range("DeptDesc").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    End If
    Range("ReportArea").Select
    Selection.Calculate
    Application.ExecuteExcel4Macro "ZeroSuppress()"
    Application.Goto Reference:="ReportArea"
    ActiveWindow.SelectedSheets.PrintOut Copies:=1
    Worksheets("Lists").Select
    Range("SegmentValues").Select
    ActiveCell.Offset(Position, 0).Select
    Position = Position + 1
    SegmentValues = ActiveCell.Value
    Loop
    End Sub

  2. #2
    Gold Lounger
    Join Date
    Feb 2001
    Location
    Dublin, Ireland, Republic of
    Posts
    2,697
    Thanks
    1
    Thanked 0 Times in 0 Posts

    Re: Macro to paste fields from two lists into a sheet

    I have not read through all your code, but a suggestion might help. If you are copying the dept code could you not then do a lookup of the code to provide the Dept name. It would require a Table with the Code No in one column and the Department name in the column to the right. A Vlookup function could then provide the department name for any given dept code. Is such a solution viable ?

    Andrew C

  3. #3
    2 Star Lounger
    Join Date
    Apr 2001
    Location
    Vancouver, Canada
    Posts
    131
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Macro to paste fields from two lists into a sheet

    That sounds like a great idea...however I don't know much about VLOOKUP. The data (department number and name) is already set up as you suggest but it's on a separate sheet from where I want it posted.

    Would I need to put VLOOKUP into the macro because the macro loops and prints the departments sequentially or would the function just recalculate when the sheet recalculates. (Now that I wrote that...I'm thinking it will likely just recalculate in the sheet, right?)

    Could you give me the syntax I need for the VLOOKUP formula?

    Thanks,

    Christa

  4. #4
    3 Star Lounger
    Join Date
    Dec 2000
    Location
    Vancouver, Br. Columbia, Canada
    Posts
    268
    Thanks
    0
    Thanked 1 Time in 1 Post

    Re: Macro to paste fields from two lists into a sheet

    Christa:

    See the attached s/sheet.

    There is a named range called "table" that contains your department codes and descriptions. Elswhere (cell D30) I have entered the formula:

    =VLOOKUP(C30,TABLE,2,FALSE)

    This will look at the value in C30, and then find a coresponding value in the first column of the "table." It will then 'read across' 2 columns (where the left-most column is #1, not 0) and return the value found in the coresponding cell. The operand "False" tells the function to accept exact matches only - it you leave this out, an entry of -say- "48" (which does not corespond to any department name) would return the name of the last match of a value less than 48 - in this case, department 45 - "Product Marketing, Footwear"

    It strikes me that it may be easier to use a "department sequence" - it is simpler to loop through sequences of integers than department numbers. In this case, you woudl establish a table as shown, and use the formulas in cells C3232. Putting coresponding formulas in your s/sheet would make the department number and description recalculate each time you changed the sequence number. If that was in a range named "seqRange" your code would be something like:

    ...
    For i = 1 to MaxDept
    [seqRange].Value = i
    <run reports, etc>
    Next i
    ...
    Attached Files Attached Files

  5. #5
    Gold Lounger
    Join Date
    Feb 2001
    Location
    Dublin, Ireland, Republic of
    Posts
    2,697
    Thanks
    1
    Thanked 0 Times in 0 Posts

    Re: Macro to paste fields from two lists into a sheet

    To use the VLOOKUP function you need a table with at least two columns. In your case we will call it Departments. The left column will hold the number and the right column the Dept name. The best approach is to name the table as sya Departments. To do that just select the entire table, numbers and description and go to Insert Name and select Define, and enter the name. That makes it easier to refer to in formulas.

    With the table in place you can use the following VLOOKUP syntax, :

    VLOOKUP(DeptNo,Departments,2,False).

    Example, in A1 you have a department number, the table of Departments is called Departments. To put th ename of the Department in B1 the following formula should be entered in B1 :

    =VLOOKUP(A1,Departments,2,False). The False (recommended) parameter is required if you want an exact match for the Dept number.

    See if that can meet your requirements, and if you would like some further help please ask. if possible include a sample workbook of what you are doing with dummy data. A better solution might then suggest itself.

    Hope you follow the above

    Andrew

  6. #6
    2 Star Lounger
    Join Date
    Apr 2001
    Location
    Vancouver, Canada
    Posts
    131
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Macro to paste fields from two lists into a sheet

    Thank you! The VLOOKUP worked great!

  7. #7
    2 Star Lounger
    Join Date
    Apr 2001
    Location
    Vancouver, Canada
    Posts
    131
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Macro to paste fields from two lists into a sheet

    Thank you, Andrew for taking the time to help a "dummy"...I was under a time crunch and your information was invaluable.

    Thanks again, <img src=/S/smile.gif border=0 alt=smile width=15 height=15>

  8. #8
    Gold Lounger
    Join Date
    Feb 2001
    Location
    Dublin, Ireland, Republic of
    Posts
    2,697
    Thanks
    1
    Thanked 0 Times in 0 Posts

    Re: Macro to paste fields from two lists into a sheet

    A dummy you are not, and I hope I did not give the impression that I thought you were. Hope you have the problem sorted.

    Andrew

Posting Permissions

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