Previous Topic Next Topic

Auto-fill items repeatedly for two sheets based on another

Solved/Closed
leapout Posts 20 Registration date Monday March 1, 2021 Status Member Last seen April 26, 2022 - Updated on Feb 16, 2022 at 05:20 PM
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen January 16, 2023 - Feb 24, 2022 at 11:46 AM
Hello,

I have two sheets(FIL1,FIL2) should auto fill some items into column A repeatedly . it depends on sheet REP after matching based on column A across sheets .
so in column B in sheets(FIL1,FIL2) if the items are completely matched with column B,C,D together for sheet REP supposes see to column A for each item contain CLASSIFICATION then should auto-fill for all items in column A for sheets (FIL1,FIL2) with considering repeat CLASSIFICATION for some items . and if the items in column B in sheets(FIL1,FIL2)are not matched with column B,C,D together for REP then should ignore it. I put the expected result for sheets (FIL1,FIL2)into columns F,G when auto-fill .
sheet REP


sheet FIL1


sheet FIL2


result into
sheet FIL1


sheet FIL2


I hope what I look for it can be possible and logical

for correction ignore the part of last line into columns F,G when auto-fill .

thanks in advance

1 reply

Answer 1 / 1
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen January 16, 2023 545
Feb 22, 2022 at 12:08 PM
Hi Leapout,

Check out the following code: 
Sub RunMe()
Dim mVal1, mVal2 As String
Dim lRow, x As Long

Sheets("FIL1").Select

With Sheets("REP")
    lRow = .Range("B1").End(xlDown).Row
    For Each cell In Range("B2:B" & Range("B1").End(xlDown).Row)
        mVal1 = Replace(cell.Value, " ", vbNullString)
        x = 1
        Do
            x = x + 1
            mVal2 = Replace(.Cells(x, "B") & .Cells(x, "C") & .Cells(x, "D"), " ", vbNullString)
            If mVal1 = mVal2 Then
                If .Cells(x, "A").Value <> vbNullString Then
                    cell.Offset(0, -1).Value = .Cells(x, "A").Value
                Else
                    cell.Offset(0, -1).Value = .Cells(x, "A").End(xlUp).Value
                End If
            End If
        Loop Until x = lRow
    Next cell
End With
End Sub


This is the code for FIL1. Change it on code line 5 for FIL2.

Best regards,
Trowa

1
leapout Posts 20 Registration date Monday March 1, 2021 Status Member Last seen April 26, 2022 1
Updated on Feb 22, 2022 at 01:59 PM
Hi Trowa,
Impressive! Actually I got idea from some forum to implement your code for two sheets by putting in array.
So see bold some adjusting how your code becomes. 


Sub RunMe()
Dim mVal1, mVal2 As String
Dim lRow, x As Long
Dim ws as variant
ws = array(FIL1","FIL2")
with ws
With Sheets("REP")
    lRow = .Range("B1").End(xlDown).Row
    For Each cell In Range("B2:B" & Range("B1").End(xlDown).Row)
        mVal1 = Replace(cell.Value, " ", vbNullString)
        x = 1
        Do
            x = x + 1
            mVal2 = Replace(.Cells(x, "B") & .Cells(x, "C") & .Cells(x, "D"), " ", vbNullString)
            If mVal1 = mVal2 Then
                If .Cells(x, "A").Value <> vbNullString Then
                    cell.Offset(0, -1).Value = .Cells(x, "A").Value
                Else
                    cell.Offset(0, -1).Value = .Cells(x, "A").End(xlUp).Value
                End If
            End If
        Loop Until x = lRow
    Next cell
End With
End With
End Sub

many thanks for your great work
0
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen January 16, 2023 545 > leapout Posts 20 Registration date Monday March 1, 2021 Status Member Last seen April 26, 2022
Feb 24, 2022 at 11:46 AM
That's great Leapout, thanks for posting the updated solution!
0