Code not to resize if count is 1

[RAJESH1960]

Hello guys
With the help of JohnnyL's code I am trying to add a few lines from it to another application. But I am not able to place or edit the code properly. If I add those lines to the code, the data gets deleted. Can someone tell me where am I going wrong.?
Johnnyl's code where it worked in another application which I am referring to is
Resize of cells in different codes displays an error. Required to edit to count <=0 or >0
This is the link to my workbook.
edit code not to resize when count is1.xlsm

 

[RAJESH1960]

Comparing your old application I have selected the required portion and changed the range part by part. You will just have to place them in the right place and define the variable.

' if data is not entered

    If Sheets("BankData").Range("A3") = vbNullString Then
        MsgBox "Enter Data from A3."
        Exit Sub
    End If



'code ClearOldWorkings of Import bank from A3:BD Rows.Count).End(xlUp)
    With Sheets("ImportBank")
        .Range("A3:BD" & .Range("A" & .Rows.Count).End(xlUp).Row).ClearContents                     '   Erase A2:ABx range of data
    End With
'code ClearOldWorkings of Extract from A3:C Rows.Count).End(xlUp)
    
    With Sheets("Extract")
        .Range("A3:C" & .Range("A" & .Rows.Count).End(xlUp).Row).ClearContents                     '   Erase A2:ABx range of data
    End With






    With Sheets("Extract")
        LastColumnNumberInRowExtract = .Cells(2, .Columns.Count).End(xlToLeft).Column          ' Get last column number in row
        LastColumnLetterSheetExtract = Split(Cells(1, (.Cells.Find("*", _
            , xlFormulas, , xlByColumns, xlPrevious).Column)).Address, "$")(1)                      ' Get last column letter used in Sheets("Extract")
'
        .Range("A2:" & LastColumnLetterSheetExtract & 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
'
        .UsedRange.EntireColumn.AutoFit                                                             '   Set all used columns on sheet wide enough for data
    End With

    With Sheets("ImportBank")
        LastColumnNumberInRowImportBank = .Cells(2, .Columns.Count).End(xlToLeft).Column        ' Get last column number in row
        LastColumnLetterSheetImportBank = Split(Cells(1, (.Cells.Find("*", _
            , xlFormulas, , xlByColumns, xlPrevious).Column)).Address, "$")(1)                      ' Get last column letter used in Sheets("ImportBank")
'
        If LedgerCount > 1 Then .Range("A2:" & LastColumnLetterSheetImportBank & LedgerCount + 1).FillDown    ' If LedgerCount > 1 Then Create range needed to copy
        .Range("A2").Resize(LedgerCount, LastColumnNumberInRowImportBank).Copy
'
        .UsedRange.EntireColumn.AutoFit                                                             '   Set all used columns on sheet wide enough for data
    End With


    With Sheets("ImportBank")
        LastColumnNumberInRowImportBank = .Cells(2, .Columns.Count).End(xlToLeft).Column        ' Get last column number in row
        LastColumnLetterSheetImportBank = Split(Cells(1, (.Cells.Find("*", _
            , xlFormulas, , xlByColumns, xlPrevious).Column)).Address, "$")(1)                      ' Get last column letter used in Sheets("ImportBank")
'
        If LedgerCount > 1 Then .Range("A2:" & LastColumnLetterSheetImportBank & LedgerCount + 1).FillDown    ' If LedgerCount > 1 Then Create range needed to copy
        .Range("A2").Resize(LedgerCount, LastColumnNumberInRowImportBank).Copy
'
        .UsedRange.EntireColumn.AutoFit                                                             '   Set all used columns on sheet wide enough for data
    End With



    With Sheets("Extract")
        LastColumnNumberInRow = .Cells(2, .Columns.Count).End(xlToLeft).Column                  '   Get last column number in row
'
        LastColumnLetterSheetExtract = Split(Cells(1, (.Cells.Find("*", , xlFormulas, _
            , xlByColumns, xlPrevious).Column)).Address, "$")(1)                                '   Get last column letter used in Sheets("Extract")
'
        If LedgerCount > 1 Then .Range("A2:" & LastColumnLetterSheetExtract & _
                LedgerCount + 1).FillDown                                                       '   If LedgerCount > 1 Then Create range needed to copy
'
        .Range("A2").Resize(LedgerCount, LastColumnNumberInRow).Copy                            '
'
        .UsedRange.EntireColumn.AutoFit                                                         '   Set all used columns on sheet wide enough for data
    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
'
        .UsedRange.EntireColumn.AutoFit                                                             '   Set all used columns on sheet wide enough for data
    End With

 

[RAJESH1960]

This is the whole code where you have to place the above lines.

Option Explicit
Dim LedgerCount                         As Long
Sub SaveAsBankXML()
    Dim LastColumnNumberInRow               As Long
    Dim LastColumnNumberInExtractRow               As Long
    Dim x                               As Long
    Dim Y                               As Long
    Dim xmlFile                         As Object
    Dim LastColumnLetterSheetImportBank As String
    Dim LastColumnLetterSheetExtract As String
    Dim strData                         As String
    Dim strTempFile                     As String

' if data is not entered

    If Sheets("BankData").Range("A3") = vbNullString Then
        MsgBox "Data not entered in cell A3."
        Exit Sub
    End If


'code ClearOldWorkings of Import bank from A3:BD Rows.Count).End(xlUp)
'code ClearOldWorkings of Extract from A3:C Rows.Count).End(xlUp)
'insert the count>1 code of both sheets

    Sheets("ImportBank").Range("A2:" & LastColumnLetterSheetExtract & x + 1).FillDown
'

    x = Sheets("BankData").Range("A3:B" & Sheets("BankData").Range("A" & Rows.Count).End(xlUp).Row).Rows.Count                            ' Get count of rows to write to file
'
    LastColumnNumberInRow = Sheets("ImportBank").Cells(2, Sheets("ImportBank").Columns.Count).End(xlToLeft).Column  ' Get last column number in row
'
    LastColumnLetterSheetImportBank = Split(Cells(1, (Sheets("ImportBank").Cells.Find("*", , xlFormulas, _
            , xlByColumns, xlPrevious).Column)).Address, "$")(1)                                            ' Get last column letter used in Sheets("ImportBank")
'
    Sheets("ImportBank").Range("A2:" & LastColumnLetterSheetImportBank & x + 1).FillDown                            ' Create range needed to copy
'
    Sheets("ImportBank").Range("A2").Resize(x, LastColumnNumberInRow).Copy
'
    strData = CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("Text")                                       ' Save contents into strData
'
    strTempFile = "C:\Users\" & Environ("username") & "\Desktop\Bank.xml"
    CreateObject("Scripting.FileSystemObject").CreateTextFile(strTempFile, True).Write strData                      ' Write the data to file
'
    Application.CutCopyMode = False

MsgBox ("File saved on Desktop as Bank.XML Rename the File. Copy path and paste in tally.")
    
  Sheets("BankData").Activate
  Range("A2").Select
   
End Sub

 

[RAJESH1960]

As you know, I get stuck when I place the lines in the wrong order. Defining the variables is not so difficult.

 

[johnnyL]

Ok, I'll have a look see.

 

[RAJESH1960]

Please note: As I am using only one button, the clear old workings should come in the beginning of the code and then the rest of the code.

 

[johnnyL]

See if this does what you want:

Option Explicit
Dim LedgerCount                         As Long

Sub SaveAsBankXML()
    Dim LastColumnNumberInRow           As Long
    Dim LastFillDownRow                 As Long
    Dim StartRow                        As Long
    Dim x                               As Long
    Dim LastColumnLetterSheetExtract    As String
    Dim LastColumnLetterSheetImportBank As String
    Dim strData                         As String
    Dim strTempFile                     As String
'
    StartRow = 2                                                                                    ' <--- Set this to the starting row of data in
'                                                                                                   '       sheets 'BankData' & 'Extract'
' if data is not entered
    If Sheets("BankData").Range("A3") = vbNullString Then
        MsgBox "Data not entered in cell A3."
        Exit Sub
    End If
'
    If Sheets("BankData").Range("A4") = vbNullString Then LedgerCount = 1
'
    LastFillDownRow = Sheets("BankData").Range("A" & Rows.Count).End(xlUp).Row - 1                  ' Determine Last Row to fill down to in other sheets
'
'code ClearOldWorkings of Import bank from A3:BD Rows.Count).End(xlUp)
    With Sheets("ImportBank")
        LastColumnLetterSheetImportBank = Split(Cells(1, (.Cells.Find("*", _
            , xlFormulas, , xlByColumns, xlPrevious).Column)).Address, "$")(1)                      '   Get last column letter used in Sheets("ImportBank")
'
        .Range("A3:" & LastColumnLetterSheetImportBank & _
                .Range("A" & .Rows.Count).End(xlUp).Row).ClearContents                              '   Erase A3:BDx range of data
'
        .Range("A" & StartRow & ":" & LastColumnLetterSheetImportBank & StartRow).AutoFill _
                Destination:=.Range("A" & StartRow & ":" & _
                LastColumnLetterSheetImportBank & LastFillDownRow)                                  '   Fill the formulas down the 'ImportBank' range
'
        .UsedRange.EntireColumn.AutoFit                                                             '   Set all used columns on sheet wide enough for data
    End With
'code ClearOldWorkings of Extract from A3:C Rows.Count).End(xlUp)
    With Sheets("Extract")
        LastColumnLetterSheetExtract = Split(Cells(1, (.Cells.Find("*", _
            , xlFormulas, , xlByColumns, xlPrevious).Column)).Address, "$")(1)                      '   Get last column letter used in Sheets("Extract")
'
        .Range("A3:" & LastColumnLetterSheetExtract & _
                .Range("A" & .Rows.Count).End(xlUp).Row).ClearContents                              '   Erase A3:Cx range of data
'
        .Range("A" & StartRow & ":" & LastColumnLetterSheetExtract & StartRow).AutoFill _
                Destination:=.Range("A" & StartRow & ":" & _
                LastColumnLetterSheetExtract & LastFillDownRow)                                     '   Fill the formulas down the 'Extract' range
'
        .UsedRange.EntireColumn.AutoFit                                                             '   Set all used columns on sheet wide enough for data
    End With
'
    x = Sheets("BankData").Range("A3:B" & Sheets("BankData").Range("A" & Rows.Count).End(xlUp).Row).Rows.Count      ' Get count of rows to write to file
'
    LastColumnNumberInRow = Sheets("ImportBank").Cells(2, Sheets("ImportBank").Columns.Count).End(xlToLeft).Column  ' Get last column number in row
'
    Sheets("ImportBank").Range("A2").Resize(x, LastColumnNumberInRow).Copy
'
    strData = CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("Text")                                       ' Save contents into strData
'
    strTempFile = "C:\Users\" & Environ("username") & "\Desktop\Bank.xml"
    CreateObject("Scripting.FileSystemObject").CreateTextFile(strTempFile, True).Write strData                      ' Write the data to file
'
    Application.CutCopyMode = False

MsgBox ("File saved on Desktop as Bank.XML Rename the File. Copy path and paste in tally.")
    
  Sheets("BankData").Activate
  Range("A2").Select
End Sub

 

[RAJESH1960]

Good Morning JohnnyL.

 

[johnnyL]

Good Morning early bird. Did you get the worm?

 

[RAJESH1960]

Good Morning early bird. Did you get the worm?

I did not get any worm but I found a few errors.

It is showing an error. But after I commented some lines in clear old workings at 2 places it works.

.Range("A" & StartRow & ":" & LastColumnLetterSheetExtract & StartRow).AutoFill _ Destination:=.Range("A" & StartRow & ":" & _ LastColumnLetterSheetExtract & LastFillDownRow) ' Fill the formulas down the 'Extract' range ' .UsedRange.EntireColumn.AutoFit

and

.Range("A" & StartRow & ":" & LastColumnLetterSheetExtract & StartRow).AutoFill _ Destination:=.Range("A" & StartRow & ":" & _ LastColumnLetterSheetExtract & LastFillDownRow) ' Fill the formulas down the 'Extract' range ' .UsedRange.EntireColumn.AutoFit

But still If I test the code with a single row, it is deleting the data of ImportData & Extract sheet as you have not included the Ledger count >1 code at 2 places.

If LedgerCount > 1 Then .Range("A2:" & LastColumnLetterSheetImportBank & LedgerCount + 1).FillDown ' If LedgerCount > 1 Then Create range needed to copy .Range("A2").Resize(LedgerCount, LastColumnNumberInRowImportBank).Copy ' .UsedRange.EntireColumn.AutoFit

 

[RAJESH1960]

But after I commented some lines in clear old workings at 2 places it works.

Actually, this also is deleting the data of the import Bank and extract sheets.