Resize of cells in different codes displays an error. Required to edit to count <=0 or >0

[RAJESH1960]

Hello guys

First of all, I am very grateful, to JohnnyL for sharing the codes with comments. With the help of formulas and codes shared by many of the members in the forum and with the help of JohnnyL’s comments, I have tried to edit and create my first code. Thank you to each of them.

I tried to edit JohnnyL’s code to improvise and edited major changes and some additional changes in it. Except for some manual work, I have the code good and running but I am stuck at some places for which I need your expertise to complete it. I have commented some of the issues, in all the codes which need to be replaced by editing some lines. Out of the 7 macro buttons, 2 are dummy as mentioned next to the macro. Those steps have to be done manually, To get the final result, the macro buttons have to be pressed in the same order.

Now, for the problems I could not solve and need your expertise to solve and complete this project.

• I have to manually select the cells from AC2 to AU2 and double click every time. I need help to write the code in such a way that it can be included in the “Move PasteData to CopyData” code.
• When I press the button “Get NA Ledgers to MasterData”, and if there are no NA ledgers in the MasterData sheet, it generates an error. Hence I need to add an extra line If B2 =<1 Then exit sub… else play the rest of the code… something like that. Same solution goes for all the other button codes.
• In each code where changes are required, which I was unable to write the code, I have commented at each line where the code requires editing.
• The split address code is in the MasterData sheet which displays the correct result when played in that sheet only. Also, it doesn’t run in option explicit. I need your expertise to correct the code and include it one of the above codes wherever it is required.
• Most of the Application lines of code have changed or deleted while editing each macro - Application.ScreenUpdading, True / False, Application.CutCopyMode = False / True, etc., I have no idea why and where to place them.
• When the project is over, there will be only 2 sheets on display – List of Ledgers and PasteData. Rest of the sheets need to be hidden with a code. (This is possible and I can do it once the above problems are solved.
• Finally, for the most difficult and biggest problem. Enter January and February in List of ledgers sheet Cells A1 and A2 respectively and run the buttons one by one.

If possible, then, try to combine all the 7 codes in 2 or max 3 buttons. I would really appreciate that. Like ClearData, Generate Master XML and Generate Purchases XML. Just wondering if it is possible, to put it all in one button and get 2 xml’s generated and saved on the desktop.

Please note: I have a copy of all the sheets in the workbook and hidden it. By any chance, while testing or editing the code, it gets deleted or the formulas and data are deleted, it will not be a problem to copy the data again - by clicking the select sheet button, copy and paste.

Important Note: Please do not run JohnnyL’s code. It is just for reference only as the presentation,working and range of cells in the code of the sheets have changed.
Edit & Combine codes.xlsm

 

[RAJESH1960]

It's amazing you corrected it. Thanks man. ???

 

[RAJESH1960]

JohnnyL. One final issue is pending in the list. Combining the codes to 2 buttons. Please share it if you are done.

 

[RAJESH1960]

If possible, then, try to combine all the 7 codes in 2 or max 3 buttons. I would really appreciate that. Like ClearData, Generate Master XML and Generate Purchases XML. Just wondering if it is possible, to put it all in one button and get 2 xml’s generated and saved on the desktop.

This one....

 

[johnnyL]

If there are no more issues to resolve in the coding, sure. I think you can reduce the button count down to two with the following code. Create a copy of the workbook with all of the sheets, delete all of the modules you currently have and then copy the following into one module:

Option Explicit
    
    Dim LedgerCount                         As Long
    Dim R


Sub GenerateMasterXML()
'
    Dim LastColumnNumberInRow               As Long
    Dim LastColumnLetterSheetImportMasters  As String
'
    Application.ScreenUpdating = False
'
'--------------------------------------------------------------------------------------------------
'
    Call Pre_XML_Code                                                                           ' Perform preliminary actions
'
    If Sheets("MasterData").Range("B2") = vbNullString Then                                     ' If B2 in MasterData is blank then ...
        MsgBox "All Ledgers Available. Press Generate Purchase.XML"                             '   Display message to user
        Exit Sub                                                                                '   Exit the code
    End If
'
    LedgerCount = Sheets("MasterData").Range("B2:B" & Sheets("MasterData").Range("B" & _
            Rows.Count).End(xlUp).Row).Rows.Count                                               ' Get count of rows to write to file
'
    With Sheets("ImportMasters")
        LastColumnNumberInRow = .Cells(2, .Columns.Count).End(xlToLeft).Column                  '   Get last column number in row
'
        LastColumnLetterSheetImportMasters = Split(Cells(1, (.Cells.Find("*", , xlFormulas, _
            , xlByColumns, xlPrevious).Column)).Address, "$")(1)                                '   Get last column letter used in Sheets("ImportMasters")
'
        If LedgerCount > 1 Then .Range("A2:" & LastColumnLetterSheetImportMasters & _
                LedgerCount + 1).FillDown                                                       '   If LedgerCount > 1 Then Create range needed to copy
'
        .Range("A2").Resize(LedgerCount, LastColumnNumberInRow).Copy                            '
    End With
'
    Call GenerateXML("Master.xml")
'
    MsgBox ("File saved on Desktop as Master.XML.")
End Sub



Sub GeneratePurchaseXML()
'
    Dim LastColumnNumberInRowImportPurchase As Long
    Dim LastColumnNumberInRowPurchaseData   As Long
    Dim LastColumnLetterSheetImportPurchase As String
    Dim LastColumnLetterSheetPurchaseData   As String
'
    Application.ScreenUpdating = False
'
'--------------------------------------------------------------------------------------------------
'
    Call Pre_XML_Code                                                                           ' Perform preliminary actions
'
    If Sheets("PurchaseData").Range("A2") = "" Then
        MsgBox "Data Not Found"
        Exit Sub
    End If
'
    R = Sheets("CopyData").Range("A2:A" & Sheets("CopyData").Range("A" & _
            Rows.Count).End(xlUp).Row).Rows.Count                                                   ' Get count of rows to write to file
'
    With Sheets("PurchaseData")
        LastColumnNumberInRowPurchaseData = .Cells(2, .Columns.Count).End(xlToLeft).Column          ' Get last column number in row
        LastColumnLetterSheetPurchaseData = Split(Cells(1, (.Cells.Find("*", _
            , xlFormulas, , xlByColumns, xlPrevious).Column)).Address, "$")(1)                      ' Get last column letter used in Sheets("PurchaseData")
'
        .Range("A2:" & LastColumnLetterSheetPurchaseData & R + 1).FillDown                          ' Create range needed to copy
        LedgerCount = .Range("B2:B" & .Range("B" & Rows.Count).End(xlUp).Row).Rows.Count            ' Get count of rows to write to file
    End With
'
    With Sheets("ImportPurchase")
        LastColumnNumberInRowImportPurchase = .Cells(2, .Columns.Count).End(xlToLeft).Column        ' Get last column number in row
        LastColumnLetterSheetImportPurchase = Split(Cells(1, (.Cells.Find("*", _
            , xlFormulas, , xlByColumns, xlPrevious).Column)).Address, "$")(1)                      ' Get last column letter used in Sheets("ImportPurchase")
'
        If LedgerCount > 1 Then .Range("A2:" & LastColumnLetterSheetImportPurchase & LedgerCount + 1).FillDown    ' If LedgerCount > 1 Then Create range needed to copy
        .Range("A2").Resize(LedgerCount, LastColumnNumberInRowImportPurchase).Copy
    End With
'
    Call GenerateXML("Purchase.xml")
'
    MsgBox ("File saved on Desktop as Purchase.XML. Copy path and paste in tally.")
End Sub



Sub Pre_XML_Code()
'
    Dim c, a, l&
    Dim Data, Ledger, Chk, i As Long
    Dim J, k, n, ar, nChar, xstr
    Dim t()     As String
    Dim arr()
    Dim ws1     As Worksheet
'
'
'--------------------------------------------------------------------------------------------------
'
' ClearOldWorkings
    With Sheets("CopyData")
        .Range("A2:AB2", .Range("A2:AB2").End(xlDown)).ClearContents
        .Range("AC3:AU3", .Range("AC3:AU3").End(xlDown)).ClearContents
    End With
'
'--------------------------------------------------------------------------------------------------
'
    With Sheets("MasterData")
        .Range("B2:E2", .Range("B2:E2").End(xlDown)).ClearContents
        .Range("F2:I10", .Range("F2:I10").End(xlDown)).ClearContents
    End With
'
'--------------------------------------------------------------------------------------------------
'
' Clear common data from the following sheets
    Call ClearCommonDataFromSheet(Sheets("PurchaseData"))
    Call ClearCommonDataFromSheet(Sheets("ImportMasters"))
    Call ClearCommonDataFromSheet(Sheets("ImportPurchase"))
'
    MsgBox "Old Data Cleared."
'
'--------------------------------------------------------------------------------------------------
'
' Move_PasteData_to_CopyData
    With Sheets("PasteData")
        l = .Cells(Rows.Count, 1).End(xlUp).Row
        c = .Evaluate("iferror(MATCH(CopyData!A1:Z1,A1:zz1,),99)")
        R = .Evaluate("ROW(A2:A" & l & ")")
        a = Application.Index(.[a:zz], R, c)
'
        If l > 2 Then                                                                                   '   If more than 1 row of data then ...
            Sheets("CopyData").[A2:Z2].Resize(UBound(a)) = a    'if additional expense columns added then change range Z2
        Else
            Sheets("CopyData").Range("A2:Z2") = a    'if additional expense columns added then change range Z2
        End If
    End With
'
    If l > 2 Then                                                                                   '   If more than 1 row of data then ...
        Sheets("CopyData").Range("AC2:AU" & Sheets("CopyData").Cells(Rows.Count, 1).End(xlUp).Row).FillDown ' Copy the AC2:AU2 formulas down to last row of A
    End If
'
'--------------------------------------------------------------------------------------------------
'
' Get_NA_Ledgers
    With Sheets("CopyData")
        Data = .Range("N2:N" & .Cells(.Rows.Count, 14).End(xlUp).Row).Value
    End With
'
    With Sheets("List of Ledgers")
        Ledger = .Range("A1:A" & .Cells(.Rows.Count, 1).End(xlUp).Row).Value
    End With
'
    With CreateObject("Scripting.Dictionary")
        If IsArray(Data) Then                                                                   ' Check to see if 'Data' is an array
            For i = 1 To UBound(Data)                                                           '   If it is an array then loop through it
                Chk = Application.Match(Data(i, 1), Application.Index(Ledger, , 1), 0)
                If IsError(Chk) And Not .Exists(Data(i, 1)) Then .Add Data(i, 1), ""
            Next i
        Else                                                                                    ' If it is not an array then there was only 1 item to save
            Chk = Application.Match(Data, Application.Index(Ledger, , 1), 0)                    '   Handle Data as a normal variable
            If IsError(Chk) And Not .Exists(Data) Then .Add Data, ""
        End If
'
        If .Count > 0 Then                                                                      '   If dictionary count > 0 then ...
            Sheets("MasterData").Range("B2").Resize(.Count) = Application.Transpose(.keys)
            LedgerCount = .Count                                                                '       Save the LedgerCount
        Else
            MsgBox "All Ledgers Available."                                                     '       Display message to user
        End If
    End With
'
    With Sheets("MasterData")
        .Range("C:E").NumberFormat = "General"                                                  ' Set columns to General format
'
        .Range("C2").Formula = "=IFERROR(IF(B2="""","""",VLOOKUP(B2,CopyData!$N$2" & _
            ":$O$" & Sheets("CopyData").Cells(Rows.Count, 1).End(xlUp).Row & ",2,0)),"""")"     ' Write updated formula to C2
        .Range("D2").Formula = "=IFERROR(VLOOKUP(LEFT($C2,2)+0,'States Code'!$A$1:$B$37,2,0),"""")" ' Write formula to D2
        .Range("E2").Formula = "=IFERROR(VLOOKUP(B2,CopyData!$N$2:$P$" & _
            Sheets("CopyData").Cells(Rows.Count, 1).End(xlUp).Row & ",3,0),"""")"               ' Write updated formula to E2
'
        If LedgerCount > 1 Then .Range("C2:E" & .Cells(Rows.Count, 2).End(xlUp).Row).FillDown   ' Copy the C2:E2 formulas down to last row of B
    End With
'
'--------------------------------------------------------------------------------------------------
'
' Split_Address
'
    Set ws1 = Worksheets("MasterData")
'
    With ws1
        ar = .[A1].CurrentRegion    'row number..?
    End With
'
    ReDim Preserve arr(1 To UBound(ar, 1), 1 To 6)
'
    k = 1
    nChar = 30              'Restricts the number of characters in a cell up to total 120 characters, can edit if required in future
'
    For i = 2 To UBound(ar, 1)
        If ar(i, 5) = "" Then GoTo nexti  ' 5 is the full address in column E
        t = Split(ar(i, 5), ",")
        xstr = t(0)
        n = 1
        nChar = 20
'
        For J = 1 To UBound(t)
            t(J) = Trim(t(J))
'
            If t(J) <> "" Then
                If Len(xstr & t(J)) <= nChar Then
                    xstr = xstr & " " & t(J)
                Else
'                   ReDim Preserve arr(1 To 4, 1 To n)
                    arr(k, n) = Trim(xstr)
                    xstr = t(J)
                    n = n + 1
'
                    If n = 4 Then nChar = 100
                End If
            End If
        Next J
'
        If arr(k, n) = "" Then arr(k, n) = Trim(xstr)   'removes special characters and trims to fit 30 characters in each column
nexti:
        k = k + 1
    Next i
'
    ws1.[F2].Resize(UBound(arr, 1), 6) = arr        'destination first cell where data is split
'
    ws1.UsedRange.EntireColumn.AutoFit
End Sub



Sub ClearCommonDataFromSheet(CommonSheet As Worksheet)
'
    Dim LastRowInCommonSheet        As Long
    Dim LastColumnLetterCommonSheet As String
'
    With CommonSheet
        LastColumnLetterCommonSheet = Split(Cells(1, (.Cells.Find("*", _
            , xlFormulas, , xlByColumns, xlPrevious).Column)).Address, "$")(1)                  ' Get last column letter used in CommonSheet
        LastRowInCommonSheet = .Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row       ' Find last row # used in CommonSheet
        .Range("A3:" & LastColumnLetterCommonSheet & LastRowInCommonSheet + 1).ClearContents    ' Clear contents of cells in CommonSheet
    End With
End Sub



Sub GenerateXML(XML_FileName As String)
'
    Dim strData     As String
    Dim strTempFile As String
'
    strData = CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("Text")               ' Save contents into strData
    strTempFile = "C:\Users\" & Environ("username") & "\Desktop\" & XML_FileName
    CreateObject("Scripting.FileSystemObject").CreateTextFile(strTempFile, True).Write strData  ' Write the data to file
'
'--------------------------------------------------------------------------------------------------
'
' Wrap Up
    Application.CutCopyMode = False                                                             ' Clear clipboard and 'marching ants'
    Application.Goto Sheets("List of Ledgers").Range("A1")                                      ' Return to 'List of Ledgers' sheet cell A1
    Application.ScreenUpdating = True                                                           ' Turn ScreenUpdating back on
End Sub

After you do that, delete all of your extra buttons, leaving just the 'Generate Master XML' button and the 'Generate Purchases XML' button. Then make sure the buttons point to the proper subroutines in the module that you saved the above code into.

Hopefully I didn't create any more issues.

The order of code flow I used was 'Clear old workings, MovePasteDatatoCopyData, GetNALedgers, SplitAddress' and then the XML code for either MasterXML or PurchasesXML

I combined a lot of the code to make it shorter.

Let us know.

 

[RAJESH1960]

That is great. Let me try what you said. Will check and revert back hopefully positively if I don't face any more issues.?

 

[RAJESH1960]

That way it will come down to 3 buttons right.

 

[johnnyL]

If you read what I said, The answer to that should be clear.

 

[johnnyL]

The answer is actually in what I said two times. Once at the top & again at the bottom.

 

[RAJESH1960]

When I read the first few lines in the code, I was looking for 2 modules. My bad. Have you included today's clear Old workings or the old one. Because I have added a new code within it.

 

[johnnyL]

I am not sure what you mean by 'today's clear Old workings' so I would have to say no. You can find the clear old workings in the code and see, be careful it is broken into two parts via a call statement.

Any doubts, post what code you are referring to and I can advise.