CODEWITHSUNDEEP
vbaexcel
biz
biz

Reputation: 29

Get values from othersheet to other based on conditions in excel

I have sheet with data, i want to get data in other sheet but with conditions.For ex:

-------------------------------------------------
| Cell A   | Cell B |  Cell C    | Cell D|Cell E |        
|------------------------------------------------|
| Sku      |Order_ID|Customer_ID | Price |Status | 
|------------------------------------------------|
| TW22     |   123  |    1       |221    |   D   |
|------------------------------------------------|
| TS44     |  124   |     2      |221    |   D   |
|------------------------------------------------|
| Ts11-ab  |   33   |     3      |211    |   D   |
|------------------------------------------------|
| Ts11     |   231  |     4      |231    |   D   |
|------------------------------------------------|
| Ts11-ab  |   33   |     3      |211    |   R   |
|------------------------------------------------|
| Ts11     |   231  |     4      |231    |   R   |
|------------------------------------------------|

I have data in sheet as above in ex:, Now i want values like bellow in my other sheet ex:

-------------------------------------------------
| Cell A   | Cell B |  Cell C    | Cell D|Cell E |        
|------------------------------------------------|
| Sku      |Order_ID|Customer_ID | Price |Status | 
|------------------------------------------------|
| TW22     |   123  |    1       |221    |   D   |
|------------------------------------------------|
| TS44     |  124   |     2      |221    |   D   |
|------------------------------------------------|
| Ts11-ab  |   33   |     3      |211    |   R   |
|------------------------------------------------|
| Ts11     |   231  |     4      |231    |   R   |
|------------------------------------------------|

I have tried vlookup and other formulas find from net but not helpful as i need.

update : If an order ID has two records in Sheet 1 with status “D” and “R”, it should show entry with just status “R” in the Sheet 2.And if there is only one record with status “D”, then it should show that record in the sheet 2. thanks

Upvotes: 2

Views: 110

Answers (3)

Aditya Pansare
Aditya Pansare

Reputation: 1132

Sorting and removing duplicates may help you.

rename sheet where you have data as "raw_data" and create new blank sheet in the same workbook named as "new_data". In sheet new_data" you will get the result.

Try below code

Sub copy_sheet()

Dim raw_data, new_data As Worksheet

Set raw_data = ThisWorkbook.Sheets("raw_data")
Set new_data = ThisWorkbook.Sheets("new_data")

raw_data.Activate
Range("A1:E1").Select
Range(Selection, Selection.End(xlDown)).Copy
new_data.Activate
Range("A1").PasteSpecial xlPasteValues
Range("A1").Sort key1:=Range("E1"), order1:=xlDescending, Header:=xlYes
Range("A1:E1").Select
Range(Selection, Selection.End(xlDown)).RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes
Range("A1").Sort key1:=Range("E1"), order1:=xlAscending, Header:=xlYes
Range("A1").Activate
End Sub

Upvotes: 2

Hambone
Hambone

Reputation: 16377

It sounds to me like you want to make use of the Dictionary class. This is packaged with VBA but isn't enabled by default -- you need to add it by adding a reference (Tools->References) to "Microsoft Scripting Runtime."

The Dictionary lets you store key-value pairs. I am assuming by your sample data that an "ORDER ID" constitutes a unique "record." If that's the case, this should work -- if not, just change the key to whatever defines a distinct record.

This code doesn't handle formatting, but you could easily manage that. This just shows you how to update values on old rows when new records appear.

Sub CopySheet()
  Dim rw As Range
  Dim findRow, newRow As Integer
  Dim ws1, ws2 As Worksheet
  Dim data As New Scripting.Dictionary
  Dim status, orderId As String

  Set ws1 = Sheets("Sheet1")
  Set ws2 = Sheets("Sheet2")
  newRow = 1

  For Each rw In ws1.Rows
    If ws1.Cells(rw.row, 1).Value2 = "" Then
      Exit For
    End If

    orderId = ws1.Cells(rw.row, 2).Value2
    status = ws1.Cells(rw.row, 5).Value2

    If data.Exists(orderId) Then
      findRow = data(orderId)   ' found it -- replace existing
      If status <> "R" Then     ' if it's not "R", don't overwrite
        findRow = 0
      End If
    Else
      findRow = newRow          ' never seen this order before
      data.Add orderId, findRow ' add it to the dictionary
      newRow = newRow + 1       ' add record on a new line
    End If

    If findRow > 0 Then
      ws2.Range("A" & findRow & ":E" & findRow).Value = _
          ws1.Range("A" & rw.row & ":E" & rw.row).Value
    End If
  Next rw
End Sub

Dictionaries are VERY efficient. This means if you have huge lists they don't suffer from the typical Excel performance lags like you do with a vlookup.

Upvotes: 2

Emily Alden
Emily Alden

Reputation: 570

Note: I'm very new to VBA myself so this is messy, but should work.

Let RawData be the first sheet you mentioned with the full list with duplicates and let NewData be the second sheet with the "R"'s removed if a "D" exists. 

Option Explicit

Sub RemoveDuplicates()
Dim i As Integer
i = 3
Worksheets("RawData").Activate
Range("A1:E2").Copy
Worksheets("NewData").Activate
Range("A1").Activate
        ActiveCell.PasteSpecial Paste:=xlPasteValues

Do While Sheets("RawData").Cells(i, 1).Value <> ""
If Sheets("NewData").Range("A:A").Find(Sheets("RawData").Cells(i, 1),         LookAT:=xlWhole) Is Nothing Then
Worksheets("RawData").Activate
Range(Cells(i, 1), Cells(i, 5)).Copy
Worksheets("NewData").Activate
        Range("A1").End(xlDown).Offset(1, 0).Activate
        ActiveCell.PasteSpecial Paste:=xlPasteValues
Else
    Worksheets("RawData").Activate
Range(Cells(i, 1), Cells(i, 5)).Copy
Worksheets("NewData").Activate
Sheets("NewData").Range("A:A").Find(Sheets("RawData").Cells(i, 1),     LookAT:=xlWhole).Activate
        ActiveCell.PasteSpecial Paste:=xlPasteValues
  End If

  i=i+1
  Loop

So what it does is check whether the item already exists in the list. If it does then it overwrites it with the new data.

Upvotes: 3

Related Questions