Add code to replace formula

[RAJESH1960]

Hello guys,
At present, In MasterData sheet I am using formulas in cells C2 and D2 dragged till more than 100 rows. I want to resize cells C2 and D2 with B2. So that I don’t have to drag the formula to 100 or more rows every time I use a new data. I want to add this extra line of code but where, I am confused. Or maybe you would want to write your own code.

Option Explicit

Sub MoveDataToDifferentSheetsV3a()
'new edited code of JohnnyL
    Application.ScreenUpdating = False                                                              ' Turn ScreenUpdating off
    Dim DictionaryRow                       As Long
    Dim FormulaNumber                       As Long
    Dim List_of_LedgersColumnA_LastRow      As Long, ParticularsLastRow                     As Long, SourceLastRow  As Long
    Dim SourceHeaderColumnNumber            As Long, SourceHeaderRow                        As Long
    Dim cell                                As Range
    Dim SourceLastColumnLetter              As String
    Dim VlookupStartAddress                 As String
    Dim DataDictionary                      As Variant
    Dim FormulaArray                        As Variant, List_of_LedgersFormulaResultsArray  As Variant, PasteDataParticularsDataArray   As Variant
    Dim SourceWS                            As Worksheet
    Set SourceWS = Sheets("PasteData")                                                              ' <--- Set this to the source sheet
    VlookupStartAddress = "$A$6"                                                                    ' <--- Set this to the proper start address
    Sheets("MasterData").Range("B2", Sheets("MasterData").Range("B2").End(xlDown)).ClearContents    ' Clear old data from Sheets("MasterData")
    Sheets("List of Ledgers").Columns("E:F").ClearContents                                          ' Clear old data from Sheets("List of Ledgers")
    With SourceWS
        SourceLastColumnLetter = Split(Cells(1, (.Cells.Find("*", , xlFormulas, , _
                xlByColumns, xlPrevious).Column)).Address, "$")(1)                                  '   Get last column letter used in the source sheet
        SourceLastRow = .Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row - 1              '   Get the last source row of data minus the total row
        With .Range("A1:" & SourceLastColumnLetter & SourceLastRow)                                 '   Look through the source sheet for the header row
            Set cell = .Find("Particulars", LookIn:=xlValues)                                       '       Find the header called 'Particulars'
            If Not cell Is Nothing Then                                                             '       If 'Particulars' is found then ...
                SourceHeaderRow = cell.Row                                                          '           Save the row # into SourceHeaderRow
                SourceHeaderColumnNumber = cell.Column                                              '           Save the Column # into SourceHeaderColumn
            End If
        End With
        ParticularsLastRow = .Cells(SourceHeaderRow + 1, SourceHeaderColumnNumber).End(xlDown).Row  ' Get last Row of consecutive data in 'Particulars' column
        If ParticularsLastRow = SourceLastRow + 1 Then ParticularsLastRow = ParticularsLastRow - 1    ' If no blanks found in column before the total line then subtract 1
        PasteDataParticularsDataArray = .Range(.Cells(SourceHeaderRow + 1, SourceHeaderColumnNumber), _
            .Cells(ParticularsLastRow, SourceHeaderColumnNumber))                               ' Save Data to be pasted into 2D 1 Based PasteDataParticularsDataArray
    End With
    With Sheets("List of Ledgers")
        List_of_LedgersColumnA_LastRow = .Range("A" & Rows.Count).End(xlUp).Row                         ' Get last row used in Sheets("List of Ledgers") column A
        .Range("E6").Resize(UBound(PasteDataParticularsDataArray, 1)) = PasteDataParticularsDataArray   'Display PasteDataParticularsDataArray to Sheets("List of Ledgers")
        ReDim FormulaArray(1 To UBound(PasteDataParticularsDataArray, 1))                               ' Set the number of rows for the FormulaArray
        For FormulaNumber = 1 To UBound(PasteDataParticularsDataArray, 1)                               ' Loop to put formulas into FormulaArray
            FormulaArray(FormulaNumber) = "=VLOOKUP(E" & 5 + FormulaNumber & "," & _
                    VlookupStartAddress & ":$A$" & List_of_LedgersColumnA_LastRow & ",1,0)"             '   Save Formula into FormulaArray
        Next                                                                                            ' Loop back
        .Range("F6").Resize(UBound(FormulaArray, 1)) = FormulaArray                                     'Display FormulaArray to Sheets("List of Ledgers")
        List_of_LedgersFormulaResultsArray = .Range("F6:F" & Range("F6").End(xlDown).Row)       ' Load formula column Results from Sheets("List of Ledgers") to array
        DataDictionary = .Range("E6", .Cells(Rows.Count, "F").End(xlUp))                            '   Create DataDictionary
    End With
    With CreateObject("Scripting.Dictionary")
        For DictionaryRow = 1 To UBound(DataDictionary)                                             '   Loop through each row of DataDictionary
            If Not .Exists(DataDictionary(DictionaryRow, 1)) And _
                    IsError(List_of_LedgersFormulaResultsArray(DictionaryRow, 1)) Then              '       If uniue value found &  ...
                .Add DataDictionary(DictionaryRow, 1), Array(DataDictionary(DictionaryRow, 2))      '           add unique value to DataDictionary
            End If
        Next                                                                                        '   Loop back
        If .Count > 0 Then                                                                          '   If dictionary count > 0 then ...
            Sheets("MasterData").Range("B2").Resize(.Count) = Application.Transpose(.keys)          '       Display unique values on Sheets("MasterData")
        Else
            MsgBox "All Ledgers Available."                                                         '       Display message to user
            GoTo Continue                                                                           '       Jump to Continue:
        End If
    End With
Continue:
    Application.ScreenUpdating = True                                                               ' Turn ScreenUpdating back on
MsgBox "Press Generate Master XML."
End Sub

 

[johnnyL]

That sounds like the LastRow variable is not correct. Did you check to see what the value of LastRow is?

 

[RAJESH1960]

It is working if I mention 100 rows in "PasteData!$B$7:$F$100".

 

[RAJESH1960]

T

edited the range from F to E as the data to lookup is E.

This was not required. Your code is correct. It is just not looking up the whole column till I mention the number of rows.

 

[johnnyL]

You said that already. Did you test the file in the link I provided?

 

[RAJESH1960]

JohnnyL. I think I will have to enter the range to 3000 as some of the cells can be blank under that Heading in the PasteData sheet. Thank you very much for your support.

 

[johnnyL]

If you do decide to test it, when you run the code you will get some pop up boxes, just click the cancel button on them and when it is finished, check the formula columns

 

[RAJESH1960]

If you do decide to test it, when you run the code you will get some pop up boxes, just click the cancel button on them and when it is finished, check the formula columns

There are no errors at all. It is working perfectly as I expected.?