Rene_Santos
New Member
- Joined
- Jul 23, 2019
- Messages
- 1
Hello everyone,
First of all I´d like to thank all participants on this website, which help me a lot to improve my VBA skills.
I hope to get help with my issue
Don´t get shocked about my long text, the main work is done and works.
So,
Two workbooks
1 = "CertMAIN".worksheets("RES_NEC-ISH")
2 = "IShare-Modified".worksheets(1)My current code works until now perfect where a column "B" of workbook1 is comparing
document references with column "B" in workbook 1.
When there is a match it is considering another column due to the fact that in the source workbook2,
doc refs can be three kinds of docs.
(That means one document reference number, but three times stated because of kind of document like
"CDCS", "DO" & "#CS".
Then according this the specific data like "Issue, Time Schedule & comments" will be copied in the row of match in workbook2 either in columns "W, X, Y" or "Z, AA, AB" or "AC, AD, AE", depending of the kind of document.
workbook1 Example
[TABLE="class: cms_table_cms_table_grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[TD]G[/TD]
[TD]H[/TD]
[TD]I[/TD]
[TD]...[/TD]
[TD]W[/TD]
[TD]X[/TD]
[TD]Y[/TD]
[TD]Z[/TD]
[TD]AA[/TD]
[TD]AB[/TD]
[TD]AC[/TD]
[TD]AD[/TD]
[TD]AE[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Project[/TD]
[TD]Doc Ref[/TD]
[TD]Title[/TD]
[TD]Last
Issue[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]Scheduled Date[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD][/TD]
[TD]Issue
DO /
FIT-T/AD[/TD]
[TD]Time Sch
DO / FIT-T/AD[/TD]
[TD]Comments
DO / FIT-T/AD[/TD]
[TD]Issue
CDCS[/TD]
[TD]Time Sch
CDCS[/TD]
[TD]Comments
CDCS[/TD]
[TD]Issue
#CS[/TD]
[TD]Time Sch
#CS[/TD]
[TD]Comments
#CS[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]--[/TD]
[TD]CMM010B4450/C1S[/TD]
[TD]--[/TD]
[TD]2[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]23/2019[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]--[/TD]
[TD]CMU010B3450/C1x[/TD]
[TD]--[/TD]
[TD]1[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]23/2019[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]--[/TD]
[TD]CMV010B1150/C1S[/TD]
[TD]--[/TD]
[TD]2[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]17/2019[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]--[/TD]
[TD]CMG010B3450/C1S[/TD]
[TD]--[/TD]
[TD]1[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]18/2019[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
Workbook2 Example
[TABLE="class: cms_table_cms_table_grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[TD]G[/TD]
[TD]H[/TD]
[TD]I[/TD]
[TD]J[/TD]
[TD]K[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]--[/TD]
[TD]Doc Ref[/TD]
[TD]Last
Issue[/TD]
[TD]Kind
of
Doc[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]Scheduled
Date[/TD]
[TD]Comments[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]--[/TD]
[TD]CMM010B4450/C1S[/TD]
[TD]1[/TD]
[TD]DO[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]15/2019[/TD]
[TD]sfsdfsdf[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]--[/TD]
[TD]CMM010B4450/C1S[/TD]
[TD]1[/TD]
[TD]CDCS[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]15/2019[/TD]
[TD]sdfdgsdgg[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]--[/TD]
[TD]CMM010B4450/C1S[/TD]
[TD]1[/TD]
[TD]#CS[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]17/2019[/TD]
[TD]fdb[/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]--[/TD]
[TD]CMM010B4450/C1S[/TD]
[TD]2[/TD]
[TD]DO[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]23/2019[/TD]
[TD]dfgfgg[/TD]
[/TR]
[TR]
[TD]8[/TD]
[TD]--[/TD]
[TD]CMM010B4450/C1S[/TD]
[TD]2[/TD]
[TD]CDCS[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]23/2019[/TD]
[TD]wwgf[/TD]
[/TR]
</tbody>[/TABLE]
The Target is:
The code does not include to figure out that only the latest issue of the corresponding doc ref and kind of doc has to be copied. As you can see that doc refs can be listet several time with different Issues (Revisions).
Only the data of the latest Issue shall be copied to the corresponding columns "W, X, Y" or "Z, AA, AB" or "AC, AD, AE"
I highly appreciate when someone can modify my exisiting code as shown as follow
Thank you in advance!
Best Regards
René
First of all I´d like to thank all participants on this website, which help me a lot to improve my VBA skills.
I hope to get help with my issue
Don´t get shocked about my long text, the main work is done and works.
So,
Two workbooks
1 = "CertMAIN".worksheets("RES_NEC-ISH")
2 = "IShare-Modified".worksheets(1)My current code works until now perfect where a column "B" of workbook1 is comparing
document references with column "B" in workbook 1.
When there is a match it is considering another column due to the fact that in the source workbook2,
doc refs can be three kinds of docs.
(That means one document reference number, but three times stated because of kind of document like
"CDCS", "DO" & "#CS".
Then according this the specific data like "Issue, Time Schedule & comments" will be copied in the row of match in workbook2 either in columns "W, X, Y" or "Z, AA, AB" or "AC, AD, AE", depending of the kind of document.
workbook1 Example
[TABLE="class: cms_table_cms_table_grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[TD]G[/TD]
[TD]H[/TD]
[TD]I[/TD]
[TD]...[/TD]
[TD]W[/TD]
[TD]X[/TD]
[TD]Y[/TD]
[TD]Z[/TD]
[TD]AA[/TD]
[TD]AB[/TD]
[TD]AC[/TD]
[TD]AD[/TD]
[TD]AE[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Project[/TD]
[TD]Doc Ref[/TD]
[TD]Title[/TD]
[TD]Last
Issue[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]Scheduled Date[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD][/TD]
[TD]Issue
DO /
FIT-T/AD[/TD]
[TD]Time Sch
DO / FIT-T/AD[/TD]
[TD]Comments
DO / FIT-T/AD[/TD]
[TD]Issue
CDCS[/TD]
[TD]Time Sch
CDCS[/TD]
[TD]Comments
CDCS[/TD]
[TD]Issue
#CS[/TD]
[TD]Time Sch
#CS[/TD]
[TD]Comments
#CS[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]--[/TD]
[TD]CMM010B4450/C1S[/TD]
[TD]--[/TD]
[TD]2[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]23/2019[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]--[/TD]
[TD]CMU010B3450/C1x[/TD]
[TD]--[/TD]
[TD]1[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]23/2019[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]--[/TD]
[TD]CMV010B1150/C1S[/TD]
[TD]--[/TD]
[TD]2[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]17/2019[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]--[/TD]
[TD]CMG010B3450/C1S[/TD]
[TD]--[/TD]
[TD]1[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]18/2019[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
Workbook2 Example
[TABLE="class: cms_table_cms_table_grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[TD]G[/TD]
[TD]H[/TD]
[TD]I[/TD]
[TD]J[/TD]
[TD]K[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]--[/TD]
[TD]Doc Ref[/TD]
[TD]Last
Issue[/TD]
[TD]Kind
of
Doc[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]Scheduled
Date[/TD]
[TD]Comments[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]--[/TD]
[TD]CMM010B4450/C1S[/TD]
[TD]1[/TD]
[TD]DO[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]15/2019[/TD]
[TD]sfsdfsdf[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]--[/TD]
[TD]CMM010B4450/C1S[/TD]
[TD]1[/TD]
[TD]CDCS[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]15/2019[/TD]
[TD]sdfdgsdgg[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]--[/TD]
[TD]CMM010B4450/C1S[/TD]
[TD]1[/TD]
[TD]#CS[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]17/2019[/TD]
[TD]fdb[/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]--[/TD]
[TD]CMM010B4450/C1S[/TD]
[TD]2[/TD]
[TD]DO[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]23/2019[/TD]
[TD]dfgfgg[/TD]
[/TR]
[TR]
[TD]8[/TD]
[TD]--[/TD]
[TD]CMM010B4450/C1S[/TD]
[TD]2[/TD]
[TD]CDCS[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]--[/TD]
[TD]23/2019[/TD]
[TD]wwgf[/TD]
[/TR]
</tbody>[/TABLE]
The Target is:
The code does not include to figure out that only the latest issue of the corresponding doc ref and kind of doc has to be copied. As you can see that doc refs can be listet several time with different Issues (Revisions).
Only the data of the latest Issue shall be copied to the corresponding columns "W, X, Y" or "Z, AA, AB" or "AC, AD, AE"
I highly appreciate when someone can modify my exisiting code as shown as follow
Code:
Sub CompareCopy()
Dim lngRow As Long, lngRowLast As Long
Dim avarData As Variant
Dim x As Long
Dim dictArrayIndexSrc As Object 'strKey:= DocRef#KindOf, item:= Array-Index
Dim varStrKey As Variant 'Key should always be defined as "String" to exclude problems with numbers
Dim strDocRef As String
Dim lngIndex As Long
Dim avarOutput As Variant
Dim wb2 As Workbook
Dim r As range
Dim wb1 As Workbook
Dim ws1 As Worksheet
Set wb1 = ThisWorkbook
Set ws1 = wb1.Worksheets("RES_NEC-ISH")
Set wb2 = Workbooks.Open("P:...\IShare-Modified.xlsx", False, False)
'Source-Data read-in
With wb2.Worksheets(1)
'clear filter
Call ClearAllFilterInWks(.range("A1").Parent) 'Detour, to prevent to rewriting Wks
'last row
lngRowLast = .Cells(.Rows.Count, "b").End(xlUp).row 'last row in cloumn B
'Data read-out
avarData = range(.range("B4"), .Cells(lngRowLast, "k"))
End With
'Dictionary - creating and filling
Set dictArrayIndexSrc = CreateObject("Scripting.Dictionary")
For x = 1 To UBound(avarData)
If avarData(x, 3) = "FIT_TAD" Or avarData(x, 3) = "FT" Or avarData(x, 3) = "FIT/TAD" Then
'Kind of Doc "FIT_TAD" and "FIT/TAD" and "FT" correspond to "DO"
varStrKey = CStr(avarData(x, 1) & "#" & "DO")
Else
varStrKey = CStr(avarData(x, 1) & "#" & avarData(x, 3))
End If
If dictArrayIndexSrc.Exists(varStrKey) Then
'Element is existing
Debug.Print varStrKey & " existiert bereits"
Debug.Print "erste Zeile: " & dictArrayIndexSrc(varStrKey) + 3 & " aktuelle Zeile: " & x + 3
Else
'Element is not existing
dictArrayIndexSrc.Add varStrKey, x
End If
Next
'Dst write
With ThisWorkbook.Worksheets("RES_NEC-ISH")
'clear
Call ClearAllFilterInWks(.range("A1").Parent) 'Detour, to prevent to rewriting Wks
'last row
lngRowLast = .Cells(.Rows.Count, "b").End(xlUp).row 'last row in cloumn B
'Output-Arry redimensionieren
ReDim avarOutput(1 To lngRowLast - 3, 1 To 9) As Variant
'Output-data writing in Array
For lngRow = 4 To lngRowLast
strDocRef = .Cells(lngRow, "b").Value
'DO ("FIT_TAD" and "FT" already converted into "DO" as above)
If dictArrayIndexSrc.Exists(strDocRef & "#" & "DO") Then
'Element is existing
lngIndex = dictArrayIndexSrc(strDocRef & "#" & "DO")
avarOutput(lngRow - 3, 1) = avarData(lngIndex, 2) 'Last Issue
avarOutput(lngRow - 3, 2) = avarData(lngIndex, 9) 'Scheduled Date
avarOutput(lngRow - 3, 3) = avarData(lngIndex, 10) 'Comments
Else
'Element is not existing
avarOutput(lngRow - 3, 1) = "NA"
avarOutput(lngRow - 3, 2) = "NA"
avarOutput(lngRow - 3, 3) = "NA"
End If
'CDCS
If dictArrayIndexSrc.Exists(strDocRef & "#" & "CDCS") Then
'Element is existing
lngIndex = dictArrayIndexSrc(strDocRef & "#" & "CDCS")
avarOutput(lngRow - 3, 4) = avarData(lngIndex, 2) 'Last Issue
avarOutput(lngRow - 3, 5) = avarData(lngIndex, 9) 'Scheduled Date
avarOutput(lngRow - 3, 6) = avarData(lngIndex, 10) 'Comments
Else
'Element is not existing
avarOutput(lngRow - 3, 4) = "NA"
avarOutput(lngRow - 3, 5) = "NA"
avarOutput(lngRow - 3, 6) = "NA"
End If
'#CS
If dictArrayIndexSrc.Exists(strDocRef & "#" & "#CS") Then
'Element is existing
lngIndex = dictArrayIndexSrc(strDocRef & "#" & "#CS")
avarOutput(lngRow - 3, 7) = avarData(lngIndex, 2) 'Last Issue
avarOutput(lngRow - 3, 8) = avarData(lngIndex, 9) 'Scheduled Date
avarOutput(lngRow - 3, 9) = avarData(lngIndex, 10) 'Comments
Else
'Element is not existing
avarOutput(lngRow - 3, 7) = "NA"
avarOutput(lngRow - 3, 8) = "NA"
avarOutput(lngRow - 3, 9) = "NA"
End If
Next
'Output-data writing in Wks
.range("W4").Resize(UBound(avarOutput, 1), UBound(avarOutput, 2)).Value = avarOutput
End With
'Straighting up
Set dictArrayIndexSrc = Nothing
'Rows will be adjusted
ThisWorkbook.Activate
Sheets("RES_NEC-ISH").Select
ws1.range("A4:A" & ws1.Rows.Count).RowHeight = 11.25
Workbooks("IShare-Modified.xlsx").Close
End Sub
Private Sub ClearAllFilterInWks(wks As Worksheet)
Dim tbl As ListObject
With wks
'AutoFilter
If .AutoFilterMode = True Then 'AutoFilter is existing
If .FilterMode = True Then .ShowAllData 'AutoFilter is active
End If
'table filter
For Each tbl In .ListObjects
With tbl
If .ShowAutoFilter = True Then 'tabel filter exists
If .AutoFilter.FilterMode = True Then 'table filter is active
.ShowAutoFilter = False 'turn off
.ShowAutoFilter = True 'turn on (clear all former enabled filter)
End If
End If
End With
Next
End With
End Sub
Thank you in advance!
Best Regards
René