Previous Topic Next Topic

Auto-fill items repeatedly for two sheets based on another

Solved/Closed
leapout Posts 20 Registration date Monday 1 March 2021 Status Member Last seen 26 April 2022 - 16 Feb 2022 à 05:03
TrowaD Posts 2921 Registration date Sunday 12 September 2010 Status Contributor Last seen 27 December 2022 - 24 Feb 2022 à 11:46
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
Related:

1 response

Réponse 1 / 1
TrowaD Posts 2921 Registration date Sunday 12 September 2010 Status Contributor Last seen 27 December 2022 555
22 Feb 2022 à 12:08
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

leapout Posts 20 Registration date Monday 1 March 2021 Status Member Last seen 26 April 2022 1
22 Feb 2022 à 13:35
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
TrowaD Posts 2921 Registration date Sunday 12 September 2010 Status Contributor Last seen 27 December 2022 555 > leapout Posts 20 Registration date Monday 1 March 2021 Status Member Last seen 26 April 2022
24 Feb 2022 à 11:46
That's great Leapout, thanks for posting the updated solution!

Similar discussions

Any auto clicker for Xbox One?
vic11con -
julietdcosta -

13 responses
help me to add particular cells
mathewmunna -
mathew munna -

2 responses