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

 

[johnnyL]

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.

and

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.

Please rephrase. The first 2 lines you quoted are the same line.

as far as LedgerCount goes, it should not be needed the way I coded it.

 

[RAJESH1960]

Sorry. The code is working for multiple rows but not working with single row.

 

[RAJESH1960]

Please rephrase. The first 2 lines you quoted are the same line.

as far as LedgerCount goes, it should not be needed the way I coded it.

But if I test it with a single row I am getting an error 1004 at

        .Range("A" & StartRow & ":" & LastColumnLetterSheetImportBank & StartRow).AutoFill _
                Destination:=.Range("A" & StartRow & ":" & _
                LastColumnLetterSheetImportBank & LastFillDownRow)                                  '   Fill the formulas down the 'ImportBank' range

 

[johnnyL]

Please explain how a single row does not work, Like I said, I coded it, I think, to avoid that issue.

 

[johnnyL]

Ok, No worries, gimme a second to rectify that.

 

[RAJESH1960]

Delete all the rows from row 4 till the end in BankData sheet and run the code, You will see the error.

 

[RAJESH1960]

Will be back in a jiffy

 

[johnnyL]

This should rectify that situation ... again, I didn't think it was needed with the new coding, but apparently it is:

Option Explicit
Dim LedgerCount                         As Long

Sub SaveAsBankXML()
    Dim LastColumnNumberInRow           As Long
    Dim LastFillDownRow                 As Long
    Dim LedgerCount                     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
'
        If LedgerCount <> 1 Then                                                                    '   If more than one record is found in 'BankData' then ...
            .Range("A" & StartRow & ":" & LastColumnLetterSheetImportBank & StartRow).AutoFill _
                    Destination:=.Range("A" & StartRow & ":" & _
                    LastColumnLetterSheetImportBank & LastFillDownRow)                              '       Fill the formulas down the 'ImportBank' range
        End If
'
        .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
'
        If LedgerCount <> 1 Then                                                                    '   If more than one record is found in 'BankData' then ...
            .Range("A" & StartRow & ":" & LastColumnLetterSheetExtract & StartRow).AutoFill _
                    Destination:=.Range("A" & StartRow & ":" & _
                    LastColumnLetterSheetExtract & LastFillDownRow)                                 '       Fill the formulas down the 'Extract' range
        End If
'
        .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]

This should rectify that situation ... again, I didn't think it was needed with the new coding, but apparently it is:

Option Explicit
Dim LedgerCount                         As Long

Sub SaveAsBankXML()
    Dim LastColumnNumberInRow           As Long
    Dim LastFillDownRow                 As Long
    Dim LedgerCount                     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
'
        If LedgerCount <> 1 Then                                                                    '   If more than one record is found in 'BankData' then ...
            .Range("A" & StartRow & ":" & LastColumnLetterSheetImportBank & StartRow).AutoFill _
                    Destination:=.Range("A" & StartRow & ":" & _
                    LastColumnLetterSheetImportBank & LastFillDownRow)                              '       Fill the formulas down the 'ImportBank' range
        End If
'
        .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
'
        If LedgerCount <> 1 Then                                                                    '   If more than one record is found in 'BankData' then ...
            .Range("A" & StartRow & ":" & LastColumnLetterSheetExtract & StartRow).AutoFill _
                    Destination:=.Range("A" & StartRow & ":" & _
                    LastColumnLetterSheetExtract & LastFillDownRow)                                 '       Fill the formulas down the 'Extract' range
        End If
'
        .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

It is getting worse. Are you testing the code.?
Wait. I will send you a video of what is happening.

 

[johnnyL]

Of course I tested the code.
Maybe you need to supply new data.