Fill the empty cells in column G & L  of sheet4

Sachin Singh
Sachin Singh used Ask the Experts™
Fill the empty cells in column G & L  of sheet4
copy  the data from sheet2 & sheet3 from column  D  of both the sheets  into sheet4 column G and column L
symbol sholud be same while doing this

plz see the sample file
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Excel & VBA Expert
Most Valuable Expert 2018
Awarded 2015
Try this...

Sub FillEmptyCellSheet4()
Dim ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet
Dim x2, x3, x4, dict
Dim i As Long, lr As Long
Dim arrG(), arrL()

Application.ScreenUpdating = False

Set ws2 = Sheets("Sheet2")
Set ws3 = Sheets("Sheet3")
Set ws4 = Sheets("Sheet4")
lr = ws4.Cells(Rows.Count, 1).End(xlUp).Row

ReDim arrG(1 To lr, 1 To 1)
ReDim arrL(1 To lr, 1 To 1)

x2 = ws2.Range("A1").CurrentRegion.Value
x3 = ws3.Range("A1").CurrentRegion.Value
x4 = ws4.Range("A1:T" & lr).Value
Set dict = CreateObject("Scripting.Dictionary")

For i = 2 To UBound(x2, 1)
    dict.Item(x2(i, 2)) = x2(i, 4)
Next i

For i = 2 To UBound(x3, 1)
    dict.Item(x3(i, 2)) = x3(i, 4)
Next i

For i = 1 To UBound(x4, 1)
    If dict.exists(x4(i, 3)) Then
        If x4(i, 7) = "" Then
            arrG(i, 1) = dict.Item(x4(i, 3))
            arrG(i, 1) = x4(i, 7)
        End If

        If x4(i, 12) = "" Then
            arrL(i, 1) = dict.Item(x4(i, 3))
            arrL(i, 1) = x4(i, 12)
        End If
    End If
Next i
ws4.Range("G1").Resize(lr, 1).Value = arrG
ws4.Range("L1").Resize(lr, 1).Value = arrL
Application.ScreenUpdating = True
End Sub

Open in new window

Click the button called "Fill Empty Cells Columns G & L" on Sheet4 to run the code.


Thnx Neeraj Sir for ur great support

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial