Click here to Skip to main content
15,870,297 members

First transfer and remove duplicates

aksh619 asked:

Open original thread
i am developing a macro which will first transfer and remove. i am using concatenated fields someone help me ..
VB
Option Explicit


Sub transferorderdata()
Dim wkbor, wkbvl, wkbysd, wkbtr As Workbook
Dim wknm, wknm1, wknm2  As String

wknm2 = "C:\vbproject\tracker\ysdflow2.xlsx"
wknm = "d:\Open.xls" '-------Open order
wknm1 = "d:\tracker.xlsx" '------tracker file
Set wkbor = Workbooks.Open(wknm)
Set wkbtr = Workbooks.Open(wknm1)
Dim irowor, irowtro, irowtrs As Integer
Dim i, j As Integer
Dim selor, seltro As String
Dim blnor As Boolean


'__________________Ordering Compare_________________
wkbor.Sheets("Filtered").Activate
irowor = wkbor.Sheets("Filtered").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
irowtro = wkbtr.Sheets("Ordering").Cells(Rows.Count, 7).End(xlUp).Offset(1, 0).Row

For i = 2 To irowor
For j = 2 To irowtro

wkbor.Sheets("Filtered").Activate
  selor = wkbor.Sheets("Filtered").Cells(i, 1).Value + wkbor.Sheets("Filtered").Cells(i, 1).Offset(0, 9).Value
'MsgBox selor
seltro = wkbtr.Sheets("ordering").Cells(i, 39).Value

If selor = seltro Then
blnor = True
'MsgBox "value equal "


Else

blnor = False

End If
If blnor = True Then

wkbtr.Sheets("Ordering").Cells(j, 7).Value = wkbor.Sheets("Filtered").Cells(i, 1).Value 'order no
wkbtr.Sheets("Ordering").Cells(j, 2).Value = wkbor.Sheets("Filtered").Cells(i, 1).Offset(0, 32).Value 'sold to party
wkbtr.Sheets("Ordering").Cells(j, 9).Value = wkbor.Sheets("Filtered").Cells(i, 1).Offset(0, 13).Value 'plnt
wkbtr.Sheets("Ordering").Cells(j, 8).Value = wkbor.Sheets("Filtered").Cells(i, 1).Offset(0, 3).Value 'svo
wkbtr.Sheets("Ordering").Cells(j, 10).Value = wkbor.Sheets("Filtered").Cells(i, 1).Offset(0, 14).Value 'shtpt
wkbtr.Sheets("Ordering").Cells(j, 11).Value = wkbor.Sheets("Filtered").Cells(i, 1).Offset(0, 38).Value ' username

wkbtr.Save
Exit For

End If

If blnor = False Then
Dim irowtro1 As Integer

irowtro1 = wkbtr.Sheets("Ordering").Cells(Rows.Count, 7).End(xlUp).Offset(1, 0).Row
wkbtr.Sheets("Ordering").Cells(irowtro1, 39).Value = selor
wkbtr.Sheets("Ordering").Cells(irowtro1, 7).Value = wkbor.Sheets("Filtered").Cells(i, 1).Value 'order no
wkbtr.Sheets("Ordering").Cells(irowtro1, 2).Value = wkbor.Sheets("Filtered").Cells(i, 1).Offset(0, 32).Value 'sold to party
wkbtr.Sheets("Ordering").Cells(irowtro1, 9).Value = wkbor.Sheets("Filtered").Cells(i, 1).Offset(0, 13).Value 'plnt
wkbtr.Sheets("Ordering").Cells(irowtro1, 8).Value = wkbor.Sheets("Filtered").Cells(i, 1).Offset(0, 3).Value 'svo
wkbtr.Sheets("Ordering").Cells(irowtro1, 10).Value = wkbor.Sheets("Filtered").Cells(i, 1).Offset(0, 14).Value 'shtpt
wkbtr.Sheets("Ordering").Cells(irowtro1, 11).Value = wkbor.Sheets("Filtered").Cells(i, 1).Offset(0, 38).Value ' username


wkbtr.Save
Exit For



End If


Next
Next


wkbtr.Save
wkbor.Close


 End Sub


it is working but at the end i am left with some duplicates entry in the final file..
some body help me out
Thanks
Akshay
Tags: VBA, Microsoft Excel, Macros

Plain Text
ASM
ASP
ASP.NET
BASIC
BAT
C#
C++
COBOL
CoffeeScript
CSS
Dart
dbase
F#
FORTRAN
HTML
Java
Javascript
Kotlin
Lua
MIDL
MSIL
ObjectiveC
Pascal
PERL
PHP
PowerShell
Python
Razor
Ruby
Scala
Shell
SLN
SQL
Swift
T4
Terminal
TypeScript
VB
VBScript
XML
YAML

Preview



When answering a question please:
  1. Read the question carefully.
  2. Understand that English isn't everyone's first language so be lenient of bad spelling and grammar.
  3. If a question is poorly phrased then either ask for clarification, ignore it, or edit the question and fix the problem. Insults are not welcome.
  4. Don't tell someone to read the manual. Chances are they have and don't get it. Provide an answer or move on to the next question.
Let's work to help developers, not make them feel stupid.
Please note that all posts will be submitted under the http://www.codeproject.com/info/cpol10.aspx.



CodeProject, 20 Bay Street, 11th Floor Toronto, Ontario, Canada M5J 2N8 +1 (416) 849-8900