Consulting

Results 1 to 6 of 6

Thread: unique records to Main worksheet in Excel VBA

  1. 09-04-2014, 12:02 PM #1
    bcomhari
    bcomhari is offline
    VBAX Regular
    Joined
    Nov 2012
    Posts
    24
    Location

    Question unique records to Main worksheet in Excel VBA

    Dear Team,

    I am working in excel vba to copy a unique records and paste to Main worksheet

    Here i have 2 sheets(1. Editable Pipeline data(Main Sheet) 2. Trace inputs ) so here i want to compare my Editable Pipeline data with Trace inputs and copy unique data values and paste into end of the cells of Main sheet (editable pipeline data)

    2nd step is do the vlookup from the Editable data to Trace inputs and fetch the other related info


    below is the code , here i am getting error becoz i am extending cell range, so please help here

    sample excel sheet also attached please help

    please help, here is the record macro
    HTML Code:
    [CODE]Sub Macro8() ' ' Macro8 Macro ' Myworkings ':
' Sheets("Trace Inputs").Select Range("A1").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Selection.End(xlUp).Select Selection.End(xlToRight).Select Range("AR1").Select ActiveSheet.Paste Selection.End(xlToLeft).Select Application.CutCopyMode = False Sheets("Editable Pipeline data").Select Range("B15").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("Workings").Select Range("A2").Select ActiveSheet.Paste Range("B2").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "Masterdata" Range("B2").Select Selection.Copy Range("A2").Select Selection.End(xlDown).Select Range("B177").Select Range(Selection, Selection.End(xlUp)).Select ActiveSheet.Paste Selection.End(xlUp).Select Range("B1").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "Data" Range("B2").Select Sheets("Trace Inputs").Select Range("F2").Select Range(Selection, Selection.End(xlDown)).Select 
Selection.Copy Sheets("Workings").Select Range("A2").Select Selection.End(xlDown).Select Range("A178").Select ActiveSheet.Paste Range("B178").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "Present Pipeline" Range("B178").Select Selection.Copy Range("A178").Select Selection.End(xlDown).Select Range("B384").Select Range(Selection, Selection.End(xlUp)).Select ActiveSheet.Paste Selection.End(xlUp).Select Application.CutCopyMode = False Selection.AutoFilter Columns("A:A").Select Selection.FormatConditions.AddUniqueValues Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority Selection.FormatConditions(1).DupeUnique = xlDuplicate With Selection.FormatConditions(1).Font .Color = -16383844 .TintAndShade = 0 End With With Selection.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .Color = 13551615 .TintAndShade = 0 End With Selection.FormatConditions(1).StopIfTrue = False ActiveSheet.Range("$A$1:$B$384").AutoFilter Field:=2, Criteria1:= _ "Present Pipeline" ActiveSheet.Range("$A$1:$B$384").AutoFilter Field:=1, Criteria1:=RGB(255, _ 255, 255), Operator:=xlFilterCellColor Range("A244").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("Editable Pipeline data").Select Selection.End(xlUp).Select Range("B15").Select Selection.End(xlDown).Select Range("B191").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("C189").Select Sheets("Workings").Select Range("A1").Select Application.CutCopyMode = False Selection.AutoFilter Columns("A:B").Select Selection.Delete Shift:=xlToLeft Sheets("Editable Pipeline data").Select Range("B190").Select Selection.End(xlUp).Select Range("B15").Select Selection.End(xlDown).Select Range("B190").Select Selection.End(xlUp).Select Range("C15").Select Selection.End(xlDown).Select Range("C191").Select ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],'Trace Inputs'!R2C6:R208C15,10,0)" Range("C191").Select Sheets("Trace Inputs").Select Range("F195").Select Selection.End(xlUp).Select Range("AR1").Select Sheets("Editable Pipeline data").Select ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],'Trace Inputs'!R2C6:R208C44,10,0)" Range("D191").Select ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],'Trace Inputs'!R2C6:R208C44,11,0)" Range("C191:D191").Select Selection.Cut Range("E191").Select ActiveSheet.Paste Range("F191").Select ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-4],'Trace Inputs'!R2C6:R208C44,14,0)" Range("F191").Select ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-4],'Trace Inputs'!R2C6:R208C44,13,0)" Range("F191").Select ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-4],'Trace Inputs'!R2C6:R208C44,12,0)" Range("G191").Select ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-5],'Trace Inputs'!R2C6:R208C44,13,0)" Range("H191").Select ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-6],'Trace Inputs'!R2C6:R208C44,14,0)" Range("I191").Select Sheets("Trace Inputs").Select Range("AF1").Select Selection.End(xlToLeft).Select Range("F1:AG1").Select Sheets("Editable Pipeline data").Select ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-7],'Trace Inputs'!R2C6:R208C44,19,0)" Range("J191").Select ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-8],'Trace Inputs'!R2C6:R208C44,28,0)" Range("K191").Select Sheets("Trace Inputs").Select Range("F1:AI1").Select Range(Selection, Selection.End(xlToRight)).Select Sheets("Editable Pipeline data").Select ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-9],'Trace Inputs'!R2C6:R208C44,30,0)" Range("Q191").Select Selection.End(xlToLeft).Select Selection.End(xlToLeft).Select Selection.End(xlToLeft).Select Selection.End(xlToLeft).Select Selection.End(xlToLeft).Select Selection.End(xlToLeft).Select Selection.End(xlToLeft).Select Selection.End(xlToLeft).Select Selection.End(xlToLeft).Select Selection.End(xlToLeft).Select Selection.End(xlToLeft).Select ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[1],'Trace Inputs'!R2C6:R208C44,39,0)" Range("A191").Select Sheets("Trace Inputs").Select Range("AE1").Select Selection.End(xlToLeft).Select Range("F1:AF1").Select Sheets("Editable Pipeline data").Select Range("Q191").Select ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-15],'Trace Inputs'!R2C6:R208C44,27,0)" Range("A191").Select Selection.Copy Range("A192").Select ActiveSheet.Paste Range("E191:Q191").Select Application.CutCopyMode = False Selection.Copy Range("E192").Select ActiveSheet.Paste Application.CutCopyMode = False ActiveWorkbook.Save Range("D187").Select Selection.End(xlUp).Select Range("D15").Select Selection.End(xlDown).Select Range("D191").Select

 End Sub[/CODE]
    Attached Files Attached Files
    Reply With Quote Reply With Quote
  2. 09-04-2014, 05:55 PM #2
    SamT
    SamT is offline
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    Please repaste your code, but this time, use the # icon to insert code tags into your post then paste the code between the code tags ([ Code]paste here[ /Code])

    First thing, though, is learn how to clean up recorded Macros.
    Whenever you see "Blah,Blah.Select(lf+cr)Selection.Blah, Blah," Delete the ".Select(lf+cr)Selection" (note: only delete one dot)
    Range("A2").Select
Selection.End(xlDown).Select
    Becomes 
    Range("A2").End(xlDown).Select
    There is a lot more Selects you can get rid of, but it takes more logic to get rid of the complicated ones.
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ
    Reply With Quote Reply With Quote
  3. 09-08-2014, 11:11 AM #3
    bcomhari
    bcomhari is offline
    VBAX Regular
    Joined
    Nov 2012
    Posts
    24
    Location
    Quote Originally Posted by SamT View Post
    Please repaste your code, but this time, use the # icon to insert code tags into your post then paste the code between the code tags ([ Code]paste here[ /Code])

    First thing, though, is learn how to clean up recorded Macros.
    Whenever you see "Blah,Blah.Select(lf+cr)Selection.Blah, Blah," Delete the ".Select(lf+cr)Selection" (note: only delete one dot)
    Range("A2").Select
Selection.End(xlDown).Select
    Becomes 
    Range("A2").End(xlDown).Select
    There is a lot more Selects you can get rid of, but it takes more logic to get rid of the complicated ones.

    Here is the code, please help

    Sub Macro8() 
'Macro8 Macro
 ' Myworkings ':' 
Sheets("Trace Inputs").Select 
Range("A1").Select 
Range(Selection, Selection.End(xlDown)).Select 
Selection.Copy 
Selection.End(xlUp).Select 
Selection.End(xlToRight).Select 
Range("AR1").Select 
ActiveSheet.Paste 
Selection.End(xlToLeft).Select 
Application.CutCopyMode = False 
Sheets("Editable Pipeline data").Select 
Range("B15").Select 
Range(Selection, Selection.End(xlDown)).Select 
Selection.Copy 
Sheets("Workings").Select 
Range("A2").Select 
ActiveSheet.Paste 
Range("B2").Select 
Application.CutCopyMode = False 
ActiveCell.FormulaR1C1 = "Masterdata" 
Range("B2").Select 
Selection.Copy 
Range("A2").Select 
Selection.End(xlDown).Select 
Range("B177").Select 
Range(Selection, Selection.End(xlUp)).Select 
ActiveSheet.Paste 
Selection.End(xlUp).Select 
Range("B1").Select 
Application.CutCopyMode = False 
ActiveCell.FormulaR1C1 = "Data" 
Range("B2").Select 
Sheets("Trace Inputs").Select 
Range("F2").Select 
Range(Selection, Selection.End(xlDown)).Select 
Selection.Copy 
Sheets("Workings").Select 
Range("A2").Select 
Selection.End(xlDown).Select 
Range("A178").Select 
ActiveSheet.Paste 
Range("B178").Select 
Application.CutCopyMode = False 
ActiveCell.FormulaR1C1 = "Present Pipeline" 
Range("B178").Select 
Selection.Copy Range("A178").Select 
Selection.End(xlDown).Select 
Range("B384").Select 
Range(Selection, Selection.End(xlUp)).Select 
ActiveSheet.Paste 
Selection.End(xlUp).Select 
Application.CutCopyMode = False 
Selection.AutoFilter Columns("A:A").Select 
Selection.FormatConditions.AddUniqueValues_
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority_
Selection.FormatConditions(1).DupeUnique = xlDuplicate_
With Selection.FormatConditions(1).Font .Color = -16383844 .TintAndShade = 0 
End With 
With Selection.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic_
 .Color = 13551615 .TintAndShade = 0 
End With 
Selection.FormatConditions(1).Stop
if true= False 
ActiveSheet.Range("$A$1:$B$384").AutoFilter Field:=2, Criteria1:="Present Pipeline" 
ActiveSheet.Range("$A$1:$B$384").AutoFilter Field:=1, Criteria1:=RGB(255,_
255, 255), Operator:=xlFilterCellColor 
Range("A244").Select 
Range(Selection, 
Selection.End(xlDown)).Select 
Selection.Copy 
Sheets("Editable Pipeline data").Select 
Selection.End(xlUp).Select 
Range("B15").Select 
Selection.End(xlDown).Select 
Range("B191").Select 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False 
Range("C189").Select 
Sheets("Workings").Select 
Range("A1").Select 
Application.CutCopyMode = False 
Selection.AutoFilter Columns("A:B").Select 
Selection.Delete Shift:=xlToLeft 
Sheets("Editable Pipeline data").Select 
Range("B190").Select 
Selection.End(xlUp).Select 
Range("B15").Select 
Selection.End(xlDown).Select 
Range("B190").Select 
Selection.End(xlUp).Select 
Range("C15").Select 
Selection.End(xlDown).Select 
Range("C191").Select 
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],'Trace Inputs'!R2C6:R208C15,10,0)" Range("C191").Select 
Sheets("Trace Inputs").Select 
Range("F195").Select 
Selection.End(xlUp).Select 
Range("AR1").Select 
Sheets("Editable Pipeline data").Select 
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],'Trace Inputs'!R2C6:R208C44,10,0)" Range("D191").Select 
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],'Trace Inputs'!R2C6:R208C44,11,0)" 
Range("C191:D191").Select 
Selection.Cut 
Range("E191").Select 
ActiveSheet.Paste 
Range("F191").Select 
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-4],'Trace Inputs'!R2C6:R208C44,14,0)" 
Range("F191").Select 
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-4],'Trace Inputs'!R2C6:R208C44,13,0)" 
Range("F191").Select 
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-4],'Trace Inputs'!R2C6:R208C44,12,0)" Range("G191").Select 
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-5],'Trace Inputs'!R2C6:R208C44,13,0)" 
Range("H191").Select 
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-6],'Trace Inputs'!R2C6:R208C44,14,0)" 
Range("I191").Select 
Sheets("Trace Inputs").Select 
Range("AF1").Select 
Selection.End(xlToLeft).Select
Range("F1:AG1").Select 
Sheets("Editable Pipeline data").Select 
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-7],'Trace Inputs'!R2C6:R208C44,19,0)" 
Range("J191").Select 
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-8],'Trace Inputs'!R2C6:R208C44,28,0)" 
Range("K191").Select 
Sheets("Trace Inputs").Select 
Range("F1:AI1").Select 
Range(Selection, Selection.End(xlToRight)).Select 
Sheets("Editable Pipeline data").Select 
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-9],'Trace Inputs'!R2C6:R208C44,30,0)" 
Range("Q191").Select
Selection.End(xlToLeft).Select 
Selection.End(xlToLeft).Select 
Selection.End(xlToLeft).Select 
Selection.End(xlToLeft).Select 
Selection.End(xlToLeft).Select 
Selection.End(xlToLeft).Select 
Selection.End(xlToLeft).Select 
Selection.End(xlToLeft).Select 
Selection.End(xlToLeft).Select 
Selection.End(xlToLeft).Select 
Selection.End(xlToLeft).Select 
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[1],'Trace Inputs'!R2C6:R208C44,39,0)" 
Range("A191").Select 
Sheets("Trace Inputs").Select 
Range("AE1").Select 
Selection.End(xlToLeft).Select 
Range("F1:AF1").Select 
Sheets("Editable Pipeline data").Select 
Range("Q191").Select 
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-15],'Trace Inputs'!R2C6:R208C44,27,0)" 
Range("A191").Select 
Selection.Copy 
Range("A192").Select 
ActiveSheet.Paste 
Range("E191:Q191").Select 
Application.CutCopyMode = False 
Selection.Copy 
Range("E192").Select 
ActiveSheet.Paste 
Application.CutCopyMode = False 
ActiveWorkbook.Save 
Range("D187").Select 
Selection.End(xlUp).Select 
Range("D15").Select
Selection.End(xlDown).Select 
Range("D191").Select
End Sub
    Last edited by Aussiebear; 09-08-2014 at 10:22 PM. Reason: Try to make code readable
    Reply With Quote Reply With Quote
  4. 09-08-2014, 03:15 PM #4
    SamT
    SamT is offline
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    Same as Before. We will teach you how to, but we will not do all that much work for you.

    This is a typical sample of your code 
    Sheets("Trace Inputs").Select
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.End(xlUp).Select
Selection.End(xlToRight).Select
Range("AR1").Select
ActiveSheet.Paste
Selection.End(xlToLeft).Select
Application.CutCopyMode = False
    What that code should look like 
    With Sheets("Trace Inputs")
Range(Range"A1"), Range("A1").End(xlDown)).Copy Range("AR1")
End With
Application.CutCopyMode = False
    And this is an awesome example of bad code which we cannot fix because we have no idea what the final selection is. 
    Range("Q191").Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ
    Reply With Quote Reply With Quote
  5. 09-08-2014, 11:31 PM #5
    bcomhari
    bcomhari is offline
    VBAX Regular
    Joined
    Nov 2012
    Posts
    24
    Location

    Question Please help

    Quote Originally Posted by SamT View Post
    Same as Before. We will teach you how to, but we will not do all that much work for you.

    This is a typical sample of your code 
    Sheets("Trace Inputs").Select
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.End(xlUp).Select
Selection.End(xlToRight).Select
Range("AR1").Select
ActiveSheet.Paste
Selection.End(xlToLeft).Select
Application.CutCopyMode = False
    What that code should look like 
    With Sheets("Trace Inputs")
Range(Range"A1"), Range("A1").End(xlDown)).Copy Range("AR1")
End With
Application.CutCopyMode = False
    And this is an awesome example of bad code which we cannot fix because we have no idea what the final selection is. 
    Range("Q191").Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select

    Dear Team,

    Here i have attached sample excel document for your reference, please help me

    May i have your contact number orelse My # 91 8123042345

    Regards,
    Hari Prasad B
    Attached Files Attached Files
    Reply With Quote Reply With Quote
  6. 09-09-2014, 06:10 AM #6
    SamT
    SamT is offline
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    First thing, though, is learn how to clean up recorded Macros.
    Whenever you see "Blah,Blah.Select(lf+cr)Selection.Blah, Blah," Delete the ".Select(lf+cr)Selection" (note: leave one dot)

    Let us start small. I repaired the first copy paste section, now you repair this section. 

        Selection.End(xlToLeft).Select
    Application.CutCopyMode = False
    Sheets("Editable Pipeline data").Select
    Range("B15").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Workings").Select
    Range("A2").Select
    ActiveSheet.Paste
    When you think you have it, show us what you did to it and we will help you make it more right.
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ
    Reply With Quote Reply With Quote
« Previous Thread | Next Thread »

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
  •  

Forum Rules