transposing information between 2 sheets

[dormanino]

Okay, this is going to be difficult to explain...i´ll do my best

in the attached excel file and in the scheenshots you can see two sheets. I need to look for information in the first sheet (see below)

13398

and compare the column a,b and c as reference to the second matrix sheet via VBA. If the "code" is found in the respective "bm" from the matrix, it adds an X...

13399

Is that possible? tried some coding...without success so far...

thank you for your attention


Sub sammelaef()
Dim plan As Worksheet
Dim plan2 As Worksheet
Set AVWMZ = Worksheets("AVWMZ")
Set sammel = Worksheets("Sammel-AEF")
'------------------
With AVWMZ
If WorksheetFunction.CountA(cells) > 0 Then
LastColumnavwmz& = .cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
End If
If WorksheetFunction.CountA(cells) > 0 Then
Lastrowavwmz& = .cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
End If
End With
'------------------
With sammel
If WorksheetFunction.CountA(cells) > 0 Then
LastColumn1Sammel& = .cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
End If
If WorksheetFunction.CountA(cells) > 0 Then
lastrowsammel& = .cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
End If
End With
'------------------

For clsammel = 2 To lastrowsammel
For clavwmzcode = 2 To Lastrowavwmz
a = sammel.range("a" & clsammelcode) & sammel.range("b" & clsammelcode) & sammel.range("c" & clsammelcode)
b = AVWMZ.range("a" & clavwmz) & AVWMZ.range("b" & clavwmz) & AVWMZ.range("c" & clavwmz)
If a = b Then
d = AVWMZ.cells(, clavwmzbm)

End If
Next clavwmz
Next clsammel
End Sub

[dormanino]

ok, solved...thanks anyway...


Sub sammelaef()
Dim plan_avwmz As Worksheet
Dim plan_sammel As Worksheet
Set plan_avwmz = Worksheets("AVWMZ")
Set plan_sammel = Worksheets("Sammel-AEF")
'------------------
With plan_avwmz
If WorksheetFunction.CountA(cells) > 0 Then
last_column_avwmz& = .cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
End If
If WorksheetFunction.CountA(cells) > 0 Then
last_row_avwmz& = .cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
End If
End With
'------------------
With plan_sammel
If WorksheetFunction.CountA(cells) > 0 Then
last_column_sammel& = .cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
End If
If WorksheetFunction.CountA(cells) > 0 Then
last_row_sammel& = .cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
End If
End With
'------------------

For row_counter_avwmz = 2 To last_row_avwmz
code_avwmz$ = plan_avwmz.cells(row_counter_avwmz, 1) & plan_avwmz.cells(row_counter_avwmz, 2) & plan_avwmz.cells(row_counter_avwmz, 3)
bm_avwmz$ = plan_avwmz.cells(row_counter_avwmz, 4)
For row_counter_sammel = 2 To last_row_sammel
code_sammel = plan_sammel.cells(row_counter_sammel, 1) & plan_sammel.cells(row_counter_sammel, 2) & plan_sammel.cells(row_counter_sammel, 3)
If code_avwmz = code_sammel Then
For column_counter_sammel = 4 To last_column_sammel
bm_sammel = plan_sammel.cells(1, column_counter_sammel)
If bm_sammel = bm_avwmz Then
plan_sammel.cells(row_counter_sammel, column_counter_sammel) = "x"
End If
Next column_counter_sammel
End If
Next row_counter_sammel
Next row_counter_avwmz

End Sub

[Paul_Hossler]

Your's takes a long time to run, and you're not using Excel's features enough.

Try this version and see. It takes about 13 seconds to run on my computer




Option Explicit
Sub Test()
Dim rplan_avwmz As Range, rplan_sammel As Range, rRow As Range
Dim vplan_sammel() As String
Dim iRow As Long, iCol As Long

Set rplan_avwmz = Worksheets("AVWMZ").Cells(1, 1).CurrentRegion
Set rplan_sammel = Worksheets("Sammel-AEF").Cells(1, 1).CurrentRegion

ReDim vplan_sammel(1 To rplan_sammel.Rows.Count)

Application.ScreenUpdating = False

For iRow = 2 To UBound(vplan_sammel)
vplan_sammel(iRow) = rplan_sammel.Cells(iRow, 1).Value & "#" & rplan_sammel.Cells(iRow, 2).Value & "#" & rplan_sammel.Cells(iRow, 3).Value
Next iRow

For Each rRow In rplan_avwmz.Rows
With rRow

Application.StatusBar = "Now doing Row #" & .Row

If .Row > 1 Then
iRow = 0
iCol = 0

On Error Resume Next
iRow = Application.WorksheetFunction.Match(.Cells(iRow, 1).Value & "#" & .Cells(iRow, 2).Value & "#" & .Cells(iRow, 3).Value, vplan_sammel, 0)
iCol = Application.WorksheetFunction.Match(.Cells(iRow, 4).Value, rplan_sammel.Rows(1), 0)
On Error GoTo 0

If iRow > 0 And iCol > 0 Then rplan_sammel.Cells(iRow, iCol).Value = "X"

If .Row Mod 1000 = 0 Then DoEvents


End If
End With
Next

Application.ScreenUpdating = True
Application.StatusBar = False
End Sub

[dormanino]

Thank you Paul, I´m still learning those resources and your spreadsheet will impulse my learnings.

another question...to determine if my matrix result will be either X or another input, where whould I include the sintax?


If iRow > 0 And iCol > 0 Then rplan_sammel.Cells(iRow, iCol).Value = "X"

and that was my alteration:


[If bm_sammel = bm_avwmz Then
If plan_avwmz.cells(row_counter_avwmz, 23) = "BG" Then
plan_sammel.cells(row_counter_sammel, column_counter_sammel) = "S"
Else
plan_sammel.cells(row_counter_sammel, column_counter_sammel) = "X"
End If

[Paul_Hossler]

I'd really have to see a small example or a set of rules

All the Match() function does is look for KZ1#KZ2#Code in an array to find a row number, and then BM in the columns to find a column number

If it finds both ( > 0) then it puts an X in that cell

[dormanino]

Thank you Paul for help once again...


I'd really have to see a small example or a set of rules

All the Match() function does is look for KZ1#KZ2#Code in an array to find a row number, and then BM in the columns to find a column number

If it finds both ( > 0) then it puts an X in that cell