Need help to correct code

[RAJESH1960]

Hello Code Experts

I am using one of Johnnyl”s code, editing it and using it for another project. I need help in some places. Firstly, I am not able to take the range of values below the particulars column which is column C as the cells are merged. So, I added another code to copy the sheet to the working sheet and used unmerged, shifted the heading “Particulars” from B10 to C10. The range need to be edited in the code.

Secondly, here is the tough part. In the List of ledgers sheet, I want the code to avoid 4 names from the list which are Opening Balance, (as per details), 2171377 which can be different in different scenarios and finally Closing Balance. That way I will get the correct ledgers, in MasterData sheet, that I have to create.

Lastly, In the ImportMasters sheet, I am getting 5 excess rows which are empty. They will generate an error when I import the xml file to the server.
If the working sheet is avoided it would be great.
Test NA Masters.xlsm

 

[johnnyL]

If the line with 'If x > 1 Then ...' has not solved your formula problem I suggest you upload the file that you are using that will produce the problem when the code is executed.

It works fine for me in the testing I did.

 

[RAJESH1960]

Edied code.xlsm
in the list of ledgers sheet replace the Ledger1 in cell A7 with anything abcdd... and test the code. Before testing check the Import Masters sheet that the formula line is displayed in row2. Then check again the same after running the code.
I faced one more problem. When all the ledgers are a match it should msgbox All ledgers available. and should not run rest of the code.

 

[RAJESH1960]

I think if you add these lines of yours from a different project, whereever necessary it may work.

Sheets("MasterData").Select
    If Sheets("MasterData").Range("A2") = "" Then

        MsgBox "All Ledgers are a Match"
        Exit Sub
    End If

 

[RAJESH1960]

I am not getting any alert messages when I receive a message. I have to refresh the page now and then to check and reply. Or I have to keep my mail open to know that I have received a message.
My next query will be about, if it is possible then, the computer generating a voice saying that I have received a message ?

 

[johnnyL]

Ahh, I see the error you made, you silly.

I am pretty sure that line of code is not causing the issue that you mentioned.

Try replacing:

    x = Sheets("MasterData").Range("B2:B" & Sheets("MasterData").Range("B" & Rows.Count).End(xlUp).Row).Rows.Count  ' Get count of rows to write to file
    LastColumnNumberInRow = Sheets("ImportMasters").Cells(2, Sheets("ImportMasters").Columns.Count).End(xlToLeft).Column  ' Get last column number in row
    LastColumnLetterSheetImportMasters = Split(Cells(1, (Sheets("ImportMasters").Cells.Find("*", , xlFormulas, _
            , xlByColumns, xlPrevious).Column)).Address, "$")(1)                                            ' Get last column letter used in Sheets("ImportMasters")
   
    Sheets("ImportMasters").Range("A2:" & LastColumnLetterSheetImportMasters & x + 1).FillDown                  ' Create range needed to copy

with:

    x = Sheets("MasterData").Range("B2:B" & Sheets("MasterData").Range("B" & Rows.Count).End(xlUp).Row).Rows.Count  ' Get count of rows to write to file
    LastColumnNumberInRow = Sheets("ImportMasters").Cells(2, Sheets("ImportMasters").Columns.Count).End(xlToLeft).Column  ' Get last column number in row
    LastColumnLetterSheetImportMasters = Split(Cells(1, (Sheets("ImportMasters").Cells.Find("*", , xlFormulas, _
            , xlByColumns, xlPrevious).Column)).Address, "$")(1)                                            ' Get last column letter used in Sheets("ImportMasters")
   
    If x > 1 Then Sheets("ImportMasters").Range("A2:" & LastColumnLetterSheetImportMasters & x + 1).FillDown                  ' Create range needed to copy

Your current code is:

        x = Sheets("MasterData").Range("B2:B" & Sheets("MasterData").Range("B" & Rows.Count).End(xlUp).Row).Rows.Count  ' Get count of rows to write to file
    LastColumnNumberInRow = Sheets("ImportMasters").Cells(2, Sheets("ImportMasters").Columns.Count).End(xlToLeft).Column  ' Get last column number in row
    LastColumnLetterSheetImportMasters = Split(Cells(1, (Sheets("ImportMasters").Cells.Find("*", , xlFormulas, _
            , xlByColumns, xlPrevious).Column)).Address, "$")(1)                                            ' Get last column letter used in Sheets("ImportMasters")
    
    If x > 1 Then Sheets("ImportMasters").Range("A2:" & LastColumnLetterSheetImportMasters & x + 1).FillDown                  ' Create range needed to copy
    
    Sheets("ImportMasters").Range("A2:" & LastColumnLetterSheetImportMasters & x + 1).FillDown                  ' Create range needed to copy

That last line there shouldn't be there. That is one of the the lines I suggested to replace.

 

[johnnyL]

I faced one more problem. When all the ledgers are a match it should msgbox All ledgers available. and should not run rest of the code.

The following should fix the 'error 13' that you were occasionally receiving as well as the 'exit sub' if all ledgers match:

Replace:

        Sheets("MasterData").Range("B2").Resize(.Count) = Application.Transpose(.keys)                              ' Display unique values on Sheets("MasterData")

with:

        If .Count > 0 Then                                                                                              ' Handle Error 13 when all match
            Sheets("MasterData").Range("B2").Resize(.Count) = Application.Transpose(.keys)                              ' Display unique values on Sheets("MasterData")
        End If
'
        If Sheets("MasterData").Range("B2") = "" Then                                                                   ' If all ledgers match then ...
            MsgBox "All Ledgers available."                                                                             '   Display message to user
            Exit Sub                                                                                                    '   Exit sub
        End If

 

[RAJESH1960]

WOW!! All the pieces are in place now. Just got up from my sleep and checked. Seems all good or maybe I am dreaming it. Will check again once I am fully awake. Can't believe it that it can be so perfect. ?

 

[RAJESH1960]

Sorry JohnnyL. I am not able to find any flaws in your code. It is so perfect. Thank You Thank You Thank you very very much.

 

[RAJESH1960]

I am very thankful to Mr.Gravanoc for solving some issues in the query. I really appreciate him for taking out his time to help and guide me. I am also grateful to Mr.JohnnyL who finally solved all the remaining issues and got me the perfect code to solve my issues. Thank you Gravanoc. Thank you JohnnyL.

 

[RAJESH1960]

I am in a dilemma right now. I don't know which post to click "Mark as solution". Posts #11, #13, #18, #32, #65, and #66 solved all my issues, part by part by gravanoc and JohnnyL together. As there is no option to click multiple posts, I will just leave it here and mark this as solution. No offence...