I want to consolidate two worksheets on the basis of a "Register No." in a third worksheet.
Workbook:
Tabelle1: Consolidated Worksheet //
Tabelle2: Input Data1 //
Tabelle3: Input Data2
Notes:
At first the "Register No." can only be found in Tabelle2 & Tabelle3 in column A.
Because Tabelle1 has also a different column sequence than Tabelle2 & Tabelle3 I am using vLookup to paste the data to the right columns in Tabelle1.
Idea:
1. Step
Pasting Tabelle2 Data, including "Register No.", to the right columns in Tabelle1 via vLookup. Note: This means "Register No." to Tabelle 1 column A.
2. Step
Pasting Tabelle3 Data to right rows and columns in Tabelle1 via vLookup.
As Tabelle3 contains more "Register No." than Tabelle2, I want my code to check the "Register No." in Tabelle1 column A and copy the corresponding data from Tabelle3.
ERROR:
The 2. Step is not working.
Runtime-Error '1004'
For example:
For i = 2 To lastrow2
Tabelle1.Cells(7 + i, 2) = Application.WorksheetFunction.VLookup(Tabelle1.Cells(i, 1), myrange2, 2, False)
Next i
Does anyone know what is wrong with my code? Thanks a lot :)
My Code:
Sub ConsolidateData()
Dim lastrow As Long
lastrow = Tabelle2.Range("A" & Rows.Count).End(xlUp).Row
Set myrange = Tabelle2.UsedRange
For i = 2 To lastrow
Tabelle1.Cells(7 + i, 1) = Application.WorksheetFunction.VLookup(Tabelle2.Cells(i, 1), myrange, 1, False)
Next i
For i = 2 To lastrow
Tabelle1.Cells(7 + i, 3) = Application.WorksheetFunction.VLookup(Tabelle2.Cells(i, 1), myrange, 2, False)
Next i
For i = 2 To lastrow
Tabelle1.Cells(7 + i, 6) = Application.WorksheetFunction.VLookup(Tabelle2.Cells(i, 1), myrange, 3, False)
Next i
Dim lastrow2 As Long
lastrow2 = Tabelle3.Range("A" & Rows.Count).End(xlUp).Row
Set myrange2 = Tabelle3.UsedRange
For i = 2 To lastrow2
Tabelle1.Cells(7 + i, 2) = Application.WorksheetFunction.VLookup(Tabelle1.Cells(i, 1), myrange2, 2, False)
Next i
For i = 2 To lastrow2
Tabelle1.Cells(7 + i, 4) = Application.WorksheetFunction.VLookup(Tabelle1.Cells(i, 1), myrange2, 3, False)
Next i
For i = 2 To lastrow2
Tabelle1.Cells(7 + i, 5) = Application.WorksheetFunction.VLookup(Tabelle1.Cells(i, 1), myrange2, 4, False)
Next i
For i = 2 To lastrow2
Tabelle1.Cells(7 + i, 7) = Application.WorksheetFunction.VLookup(Tabelle1.Cells(i, 1), myrange2, 5, False)
Next i
End Sub
I think the problem is the way you are referencing your worksheets. You are using the Worksheet.CodeName vs the Worksheet.Name of the worksheet.
Look at my example below and you will see that the Worksheet.CodeName and Worksheet.Name do not match.
Worksheet.CodeName is the 1st part of the name and Worksheet.Name is what's shown in parentheses. Therefore the Worksheet.CodeName for the second worksheet is Sheet5, whereas the Worksheet.Name is Sheet6.
This is because I deleted a worksheet and excel, behind the scenes, renamed the Worksheet.CodeName reference.
To use what you see when looking at the tabs in the workbook you need to reference it by Worksheet.Name, not Worksheet.CodeName.
Sub testPickingWorksheets()
' This code fails
a = Sheet6.Range("A1").Value
MsgBox (a)
' This code works
a = Worksheets("Sheet6").Range("A1").Value
MsgBox (a)
End Sub
As you can see from the code above, you need to use the Worksheets() Ojbect with the Worksheet.Name in "quotes" instead of directly referencing the Worksheet.CodeName.
Related
I've got a problem. I' m trying to match specific values by item_id using hlookup function. But this function does not return specified value.
Here is the code of my macro :
Sub create_report()
Dim itemWs As Worksheet, offerWs As Worksheet, testWs As Worksheet
Dim itemLastRow As Long, offerLastRow As Long
Dim offerLastCol As Long, itemLastCol As Long
Dim dataRng As Range
Set itemWs = ThisWorkbook.Worksheets("nn_rfx_compare_per_lot")
Set offerWs = ThisWorkbook.Worksheets("Offers")
Set testWs = ThisWorkbook.Worksheets("Testowy")
itemLastRow = itemWs.Range("A" & Rows.Count).End(xlUp).Row
offerLastRow = offerWs.Range("A" & Rows.Count).End(xlUp).Row
offerLastCol = offerWs.Cells(1, Columns.Count).End(xlToLeft).Column
itemLastCol = itemWs.Cells(1, Columns.Count).End(xlToLeft).Column
Set dataRng = testWs.Range("I3:AF" & 4)
'For x = 2 To 7
'On Error Resume Next
'itemWs.Range("I" & x).Value = Application.WorksheetFunction.VLookup(itemWs.Range("C" & x).Value & itemWs.Range("B" & x).Value, dataRng, 3, 0)
'Next x
Sheets("Testowy").Range(Sheets("Testowy").Cells(offerLastCol - 1, 1), Sheets("Testowy").Cells(itemLastRow + 4, itemLastCol)) = _
Sheets("nn_rfx_compare_per_lot").Range(Sheets("nn_rfx_compare_per_lot").Cells(1, 1), Sheets("nn_rfx_compare_per_lot").Cells(itemLastRow, itemLastCol)).Value
Sheets("Testowy").Range(Sheets("Testowy").Cells(1, itemLastCol), Sheets("Testowy").Cells(offerLastCol - 2, offerLastRow - 2)) = _
WorksheetFunction.Transpose(Sheets("Offers").Range(Sheets("Offers").Cells(1, 2), Sheets("Offers").Cells(offerLastRow, offerLastCol - 1)))
Dim lastTestCol As Long
lastTestCol = testWs.Cells(1, Columns.Count).End(xlToLeft).Column
Dim ColumnLetter As String
For Row = 6 To 11
For Col = 9 To lastTestCol
On Error Resume Next
testWs.Cells(Row, Col).Value = Application.WorksheetFunction.Index(testWs.Range( _
"I4:AF4"), WorksheetFunction.Match(testWs.Cells(Row, 3).Value, testWs.Cells(3, Col), 0))
'Match(testWs.Cells(Row, 3), dataRng, 1)
'HLookup(testWs.Cells(Row, 3), dataRng, 2, 0)
Next Col
Next Row
End Sub
In this link there is shown a report which I'd like to organise
enter image description here
The task and conditions are not completely clear (what to do with duplicates, whether they can occur, whether item_id is unique and so on).
If, for example, you need to select sup_id corresponding to item_id, it can be done by the following code:
Set item_id_rng = testWS.Range("I3:AF3")
For Row = 6 To 11
' search `item_id` in Range("I3:AF3")
find_col = Application.Match(testWS.Cells(Row, 3).Value, item_id_rng, 0)
If IsNumeric(find_col) Then ' if found, get correspondent value from correspondent row
'output to 9 column (empty area), for example
testWS.Cells(Row, 9).Value = item_id_rng(1).Offset(-1, find_col - 1)
End If
Next Row
As for the task as a whole, it would be good if you formulated the conditions of the task and placed an image of the result
I am using the following code to consolidate two Worksheets (Sheet 5 and Sheet 3). More precisely, I am adding the data from Sheet 5 to Sheet 3 what is working smooth as long as have opened Sheet 3 when processing the code. However, when I switch to another sheet and run the code, the code doesn't work properly anymore.
When I run the code for the first time it works smooth
When I run the code repeatedly nothing should happen, because my macro just inserts data from Sheet 5 in Sheet 3that isn't already in Sheet 3 and since this data has already been inserted in the first run nothing should happen. This is the case, when I stay on Sheet 3. However, if I switch to another sheet and run the code a second, third, fourth time, then the macro is partly executed everytime.
Let me explain this a lil bit further:
For my tests I am using three rows with data. When I execute the button a first time, all three rows in Sheet 5 are added to Sheet 3. When I press the button a second, third, fourth time three rows are added to Sheet 3
First added row: Is empty
Second & Third added row: contain the data of the second and third row in Sheet 3
Does anyone have an idea what is going wrong here?
Sub Consolidation()
Dim lastrow As Long
Dim NFR As Long
lastrow = Tabelle5.Range("A" & Rows.Count).End(xlUp).Row
NFR = Tabelle3.Range("A" & Rows.Count).End(xlUp).Offset(-3).Row
Set myrange = Tabelle5.UsedRange
For i = 4 To lastrow
On Error Resume Next
If Tabelle3.Cells(5 + i, 1) <> "" And Not IsError(Application.Match(Tabelle3.Cells(5 + i, 1), Tabelle5.Range("A:A"), False)) Then
Tabelle3.Cells(5 + i, 2) = Application.WorksheetFunction.VLookup(Tabelle3.Cells(5 + i, 1), myrange, 2, False)
End If
If IsError(Application.Match(Tabelle5.Cells(i, 1), Tabelle3.Range("A9:A" & Range("A1048576").End(xlUp).Offset(8).Row), False)) Then
Tabelle3.Cells(NFR + i, 1) = Application.WorksheetFunction.VLookup(Tabelle5.Cells(i, 1), myrange, 1, False)
Tabelle3.Cells(NFR + i, 2) = Application.WorksheetFunction.VLookup(Tabelle5.Cells(i, 1), myrange, 2, False)
End If
Next i
Set Rng = Tabelle3.Range("A9:A" & Range("A1048576").End(xlUp).Offset(8).Row)
On Error Resume Next
Rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
Something like this (untested):
Sub Consolidation()
Dim lastrow As Long
Dim NFR As Long, r, v
lastrow = Tabelle5.Range("A" & Rows.Count).End(xlUp).Row
NFR = Tabelle3.Range("A" & Rows.Count).End(xlUp).Offset(-3).Row
Set myrange = Tabelle5.UsedRange
For i = 4 To lastrow
v = Tabelle3.Cells(5 + i, 1)
If v <> "" And Not IsError(Application.Match(v, Tabelle5.Range("A:A"), False)) Then
r = Application.VLookup(v, myrange, 2, False)
Tabelle3.Cells(5 + i, 2) = IIf(IsError(r), "No match", r)
End If
v = Tabelle5.Cells(i, 1)
If IsError(Application.Match(v, Tabelle3.Range("A9:A" & _
Tabelle3.Range("A1048576").End(xlUp).Offset(8).Row), False)) Then
r = Application.VLookup(v, myrange, 1, False)
Tabelle3.Cells(NFR + i, 1) = IIf(IsError(r), "No match", r)
r = Application.VLookup(v, myrange, 2, False)
Tabelle3.Cells(NFR + i, 2) = IIf(IsError(r), "No match", r)
End If
Next i
Set Rng = Tabelle3.Range("A9:A" & Range("A1048576").End(xlUp).Offset(8).Row)
On Error Resume Next
Rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
I do have two different sheets (Tabelle2 & Tabelle3) and I want to consolidate them in a third one (Tabelle1) on basis of the Register No.
To copy Tabelle2 into the correct columns in Tabelle1 I'm using VLookup which is working smooth.
Dim lastrow As Long
lastrow = Tabelle2.Range("A" & Rows.Count).End(xlUp).Row
Set myrange = Tabelle2.UsedRange
For i = 2 To lastrow
Tabelle1.Cells(i, 1) = Application.WorksheetFunction.VLookup(Tabelle2.Cells(i, 1), myrange, 1, False)
Next i
For i = 2 To lastrow
Tabelle1.Cells(i, 2) = Application.WorksheetFunction.VLookup(Tabelle2.Cells(i, 1), myrange, 2, False)
Next i
For i = 2 To lastrow
Tabelle1.Cells(i, 6) = Application.WorksheetFunction.VLookup(Tabelle2.Cells(i, 1), myrange, 3, False)
Next i
In a 2. Step I want my code to check the "Register No." in Tabelle1 and copy only those rows from Tabelle3 to Tabelle1. Note: Tabelle3 is containing many more "Register No." which data I don't need
Does anyone know which function to use or how to solve this challange? :)
Try this
Dim lastrow As Long
lastrow = Tabelle3.Range("A" & Rows.Count).End(xlUp).Row
Set myrange = Tabelle3.UsedRange
For i = 2 To lastrow
Tabelle1.Cells(i, 3) = Application.WorksheetFunction.VLookup(Tabelle1.Cells(i, 1), myrange, 2, False)
Next i
For i = 2 To lastrow
Tabelle1.Cells(i, 4) = Application.WorksheetFunction.VLookup(Tabelle1.Cells(i, 1), myrange, 3, False)
Next i
For i = 2 To lastrow
Tabelle1.Cells(i, 5) = Application.WorksheetFunction.VLookup(Tabelle1.Cells(i, 1), myrange, 4, False)
Next i
Let's make it really simple - put the three tables on the same worksheet like this:
The idea would be to get something like this, after running the code below:
Probably the simplest way to achieve it with some bad practices as hard-coding is like this:
Public Sub TestMe()
Dim cnt As Long
Dim combinedIndex As Range
Dim currentCell As Range
With Worksheets(1)
Set combinedIndex = .Range("A7:A12")
'Fill table with names
For cnt = 2 To 5
Set currentCell = Nothing
Set currentCell = combinedIndex.Find(Cells(cnt, 1))
If Not currentCell Is Nothing Then
currentCell.Offset(0, 1) = .Cells(cnt, 2)
End If
Next cnt
'Fill table with Shoe Sizes
For cnt = 2 To 5
Set currentCell = Nothing
Set currentCell = combinedIndex.Find(Cells(cnt, 4))
If Not currentCell Is Nothing Then
currentCell.Offset(0, 2) = .Cells(cnt, 5)
End If
Next cnt
End With
End Sub
This is what the code does:
Defines the combinedIndex range. In a more general case it can be Worksheets(1).Range("A:A")
then loops through the table with the names. It is hardcoded from 2 to 5, but it can be loosened up a bit. Once a RegisterN is found, the second value is written to the offset of the found value
the same is for the Shoe Sizes table
The pic shows what happens with my code.
I have a user form and I add the labels of the user form into the selected worksheet. And this is what I tried. Now the problem is why is it that there is one cell not on the same row as the others?
Dim c As Control
For Each c In Me.Controls
If TypeName(c) = "Label" Then
With ActiveSheet
i = i + 1
Dim lastRow As Long
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
If c <> "Chapter" Then
.Range(Cells(1, 1), Cells(1, i)).Name = "Chapter1"
.Range("Chapter1").Merge
.Range("Chapter1").Value = "Chapter 1"
.Range("Chapter1").HorizontalAlignment = xlCenter
.Cells(lastRow, i).Value = c.Caption
End If
End With
End If
Next
The problem is that the first time you do .Cells(.Rows.Count, 1).End(xlUp).Row there will not be anything yet in A2, so lastRow will be 1. But once you put the value "No." in that cell the next time you execute that code (with i being 2), A2 will be filled, so now .Cells(.Rows.Count, 1).End(xlUp).Row will return 2, giving you the effect you get: all other values end up one row lower.
There are several way to solve this, but here is one way. Add + IIf(i = 1, 1, 0) the assignment of lastRow:
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + IIf(i = 1, 1, 0)
This is my code:
Dim RowLast As Long
Dim sunmLast As Long
Dim tempLast As Long
Dim filterCriteria As String
Dim perporig As Workbook
Dim x As String
tempLast = ThisWorkbook.Sheets("combine BOMs").Cells(Rows.Count, "E").End(xlUp).Row
Range("D5:G" & tempLast).ClearContents
Range("G5:G" & tempLast).Interior.ColorIndex = 0
tempLast = ThisWorkbook.Sheets("combine BOMs").Cells(Rows.Count, "A").End(xlUp).Row
Range("A5:A" & tempLast).ClearContents
tempLast = ThisWorkbook.Sheets("combine BOMs").Cells(Rows.Count, "B").End(xlUp).Row
'Perpetual
Set perporig = Workbooks.Open("\\Etnfps02\vol1\DATA\Inventory\Daily tracking\perpetual.xlsx", UpdateLinks:=False, ReadOnly:=True)
RowLast = perporig.Sheets("perpetual").Cells(Rows.Count, "A").End(xlUp).Row
perporig.Sheets("perpetual").Cells(3, 1) = "Part Number"
For i = 5 To tempLast
Cells(i, 1) = i - 4
perporig.Sheets("perpetual").AutoFilterMode = False
filterCriteria = ThisWorkbook.Sheets("combine BOMs").Range("B" & i).Value
perporig.Sheets("perpetual").Range("A3:J" & RowLast).AutoFilter Field:=1, Criteria1:=filterCriteria
Counter = perporig.Sheets("perpetual").Cells(RowLast + 1, 1).End(xlUp).Row
If Counter = 3 Then
Cells(i, 5).Value = "Not on perpetual"
Else
ThisWorkbook.Sheets("combine BOMs").Cells(i, 5).Value = WorksheetFunction.Sum(perporig.Sheets("perpetual").Range("H4:H" & RowLast).SpecialCells(xlCellTypeVisible))
x = perporig.Sheets("perpetual").Cells(Cells(RowLast + 1, 1).End(xlUp).Row, 4).Value
MsgBox x, vbOKOnly, perporig.Sheets("perpetual").Cells(RowLast + 1, 1).End(xlUp).Row
ThisWorkbook.Sheets("combine BOMs").Cells(i, 4).Value = x
End If
perporig.Sheets("perpetual").AutoFilterMode = False
Next
perporig.Close savechanges:=False
This is the file from which I am clicking my button (or ThisWorkbook)
This is the perpetual file when it is running on the last row of data:
Notice the difference in D9280: it shows stocking type as "P" in the perpetual file, but "B" in my final result, which comes up in cell D12 in ThisWorkbook. To debug, I created a Msgbox prompt for everytime it gets that value for all rows. For every other row, it gives the correct value ("P"), but for this one, msgbox shows "B". The title of the msgbox is the row number, which shows it is taking the correct row whilr getting the value, just that I don't know why it is taking wrong value. I have tried for different data sources, it seems to be coming up with "B" in wrong places every so often.
In the code, just above the line, I have the line to get the on hand quantity, which it does take correctly (I used xltypevisible to paste values for this field, but that is only because I wanted a sum of the results and this was the only way I knew). It's only this stocking type column which shows wrong values randomly.
Any ideas?
Thanks!
1)
Cells(i, 1) = i - 4
as it is written , it refers to perporig.Cells(i, 1)
is this what you want?
2)
perporig.Sheets("perpetual").Range("A3:J" & RowLast).AutoFilter Field:=1, Criteria1:=filterCriteria
would filter from row 3, while you have headers in row 4 and data from row 5 downwards
change it to
perporig.Sheets("perpetual").Range("A4:J" & RowLast).AutoFilter Field:=1, Criteria1:=filterCriteria
3)
what do you think is Counter doing? Not certainly count visible rows only
Credits to findwindow, I found the answer. The .cells(cells()) part didn't have the correct sheet reference for the inner cells():
Instead of
x = perporig.Sheets("perpetual").Cells(Cells(RowLast + 1, 1).End(xlUp).Row, 4).Value
MsgBox x, vbOKOnly, perporig.Sheets("perpetual").Cells(RowLast + 1, 1).End(xlUp).Row
I used this:
With perporig.Sheets("perpetual")
x = .Cells(.Cells(RowLast + 1, 1).End(xlUp).Row, 4).Value
MsgBox x, vbOKOnly, .Cells(RowLast + 1, 1).End(xlUp).Row
End With
And it worked.
Thanks for your help!