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]

As I told you earlier, I have to test the code 4 different ways. If it doesn't work in any one case, then that is an issue.

 

[RAJESH1960]

With 30 rows of data, the code is working without error, but it is still deleting the January row in LIst of ledgers sheet.

 

[johnnyL]

Correct, but if you are changing two different things, the deleted value from list of ledgers & deletion of cells from PasteData, how will you know which one, if not both cause an issue?

 

[johnnyL]

What is deleting the january row?

 

[RAJESH1960]

JohnnyL. Once the data is pasted in the List of Ledgers and Paste Data sheet, it is not to be tampered till the end. The code can just select data and split it in different sheets. Just imagine I have pasted a new list of ledgers in the List of ledgers where January is not in it. Then what.?

 

[RAJESH1960]

What is deleting the january row?

The Get NA ledgers macro.

 

[RAJESH1960]

Without January and with one single row of data, it is showing an error at the same line of code when I run Get NA ledgers....

 ReDim Temp(1 To UBound(Data))

 

[johnnyL]

See this is why I don't like dealing with 47 subroutines in a thread. That is why I was supplying files instead.

Let's take a breath.

The following code should be what you have for 'Move_PasteData_to_CopyData':

Sub Move_PasteData_to_CopyData()
'
    Dim c, R, a, l&
'
    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
'
    Application.Goto Sheets("List of Ledgers").Range("A1")                                              ' Return to 'List of Ledgers' sheet cell A1
End Sub

This should be what you have for 'Get_NA_Ledgers':

Sub Get_NA_Ledgers()
'
    Dim Data, Ledger, Chk, i As Long
    Dim LedgerCount As Long
'
    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
'
    ReDim Temp(1 To UBound(Data))
'
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(Data)
            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
'
        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
'
    Sheets("MasterData").Range("C:E").NumberFormat = "General"                                  ' Set columns to General format

' Convert existing formulas on 'MasterData' sheet to use LastRow detected instead of hard coded '30'
   
    Sheets("MasterData").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

    Sheets("MasterData").Range("D2").Formula = "=IFERROR(VLOOKUP(LEFT($C2,2)+0," & _
            "'States Code'!$A$1:$B$37,2,0),"""")"                                               ' Write formula to D2
    
    Sheets("MasterData").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 Sheets("MasterData").Range("C2:E" & _
            Sheets("MasterData").Cells(Rows.Count, 2).End(xlUp).Row).FillDown                   ' Copy the C2:E2 formulas down to last row of B
'
    Application.Goto Sheets("List of Ledgers").Range("A1")                                      ' Return to 'List of Ledgers' sheet cell A1
End Sub

Leave the 'PasteData' with 30 rows, Delete the January from the top of column A in 'List of Ledger' ... leaving that cell blank. Then test the code to see if the 'MasterData' sheet works properly.

 

[johnnyL]

Type Mismatch at this line

    ReDim Temp(1 To UBound(Data))

Test the following to handle that issue:

Sub Get_NA_Ledgers()
'
    Dim Data, Ledger, Chk, i As Long
    Dim LedgerCount As Long
 '
    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
            For i = 1 To UBound(Data)
                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
            Chk = Application.Match(Data, Application.Index(Ledger, , 1), 0)
            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
'
    Application.Goto Sheets("List of Ledgers").Range("A1")                                      ' Return to 'List of Ledgers' sheet cell A1
End Sub

 

[RAJESH1960]

Checking....will take some time.