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

 

[RAJESH1960]

Sheets("Workings").Select Cells.Select ActiveSheet.Paste 'need to edit below line to find row with particulars which may be in any of the rows Rows("10:10").Select Application.CutCopyMode = False Selection.UnMerge Range("B10").Select Selection.Cut Destination:=Range("C10"

Please try and delete the workings sheet. As I was not able to get the data from the merged cells I copied the data from Original to Workings sheets, unmerged it and got the data. But the problem is In the code, in the working sheet I am shifting the particulars from cell B10 to column C10 manually. I can't do that each time I generate a file. I know it was just testing. In some cases the particulars column may be in row 8 or 9 or any other row. That is why I want to avoid the working sheet.

 

[johnnyL]

I just noticed something important. Please note in the original sheet the list of all particulars is in column C and they are not merged. So, without copying the data to workings, I think you can select all the values in each row from first to last, in column C without any problem. That way the workings sheet can be avoided.

If you want to use the 'Original' sheet, change the following:

    Set SourceWS = Sheets("Workings")                                                               ' <--- Set this to the source sheet
    SourceLastColumnLetter = Split(Cells(1, (SourceWS.Cells.Find("*", , xlFormulas, , _
            xlByColumns, xlPrevious).Column)).Address, "$")(1)                                      ' Get last column letter used in the source sheet
    SourceLastRow = SourceWS.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row - 1          ' Get the last source row of data minus the total row
    With SourceWS.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

to:

    Set SourceWS = Sheets("Original")                                                               ' <--- Set this to the source sheet
    SourceLastColumnLetter = Split(Cells(1, (SourceWS.Cells.Find("*", , xlFormulas, , _
            xlByColumns, xlPrevious).Column)).Address, "$")(1)                                      ' Get last column letter used in the source sheet
    SourceLastRow = SourceWS.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row - 1          ' Get the last source row of data minus the total row
    With SourceWS.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 + 1                                              '       Save the Column # +1 into SourceHeaderColumn
'                                                                                                   '           to correct for the merged B&C columns
        End If
    End With

 

[RAJESH1960]

Thanks JohnnyL. It is good. Now I can work with one sheet less. One last issue to go.

 

[RAJESH1960]

Sheets("MasterData").Range("B2").Resize(.Count) = Application.Transpose(.keys)

Need to edit this line.
When there is only one ledger NA in Master data sheet, the code erases the 2nd row in ImportMaster Sheet with the formulas. The code runs correctly only if there are 2 or more NA ledgers in master data sheet. I want the code not to resize the cells when there is only one NA in master Data sheet since the Import Master sheet has already filled the data in the first row by default.
Hope you will understand better to solve this.

 

[RAJESH1960]

SourceHeaderColumnNumber = cell.Column + 1

This means one column right of heading Particulars. Right. Only an expert can think of this.??

 

[johnnyL]

This means one column right of heading Particulars. Right. Only an expert can think of this.??

Correct on the first part, not so much on the last part.

I just stepped through the code to see what it was doing while comparing it to what you wanted it to do, then made the correction.

 

[RAJESH1960]

Correct on the first part, not so much on the last part.

I just stepped through the code to see what it was doing while comparing it to what you wanted it to do, then made the correction.

I meant to say I would have never thought of it as I am no code expert. I just try and understand them but can't write them. That way an expert can find ways to do anything with his weapon (knowledge of coding).?

 

[johnnyL]

Sheets("MasterData").Range("B2").Resize(.Count) = Application.Transpose(.keys)

Need to edit this line.
When there is only one ledger NA in Master data sheet, the code erases the 2nd row in ImportMaster Sheet with the formulas. The code runs correctly only if there are 2 or more NA ledgers in master data sheet. I want the code not to resize the cells when there is only one NA in master Data sheet since the Import Master sheet has already filled the data in the first row by default.
Hope you will understand better to solve this.

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

 

[RAJESH1960]

Still getting the same error at the same line.

Sheets("MasterData").Range("B2").Resize(.Count) = Application.Transpose(.keys)

 

[RAJESH1960]

Run time error 13
Type mismatch