Append sheets with a code.

RAJESH1960

Banned for repeated rules violations
Joined
Mar 26, 2020
Messages
2,313
Office Version
  1. 2019
Platform
  1. Windows
Hello
JohnnyL. I have tested your last app with so many different data of HDFC bank and I have not faced any problem with any of them. It is just perfect.
Today When I started working on a different bank I found it quite different. The data is not in a single sheet but spread in different sheets which can be 1 or 2 or any number depending on the number of transactions. The one I am working on now has 23 sheets of data. I have to append the data of each sheet to one new sheet and then customize it. The headings of sheet 1 starts from row 3 and the headings of the remaining sheets start from row 1. Some of the headings are different which I will be able to change in your code to customize. The sheet name which I receive is Table1,2,3 and so on by default.
So, if you can combine / append the data with a code then the rest of it will be easy. Right now I have manually combined the data and changed the format where ever necessary. I was not able to format some of the numbers in the amount columns which I am sure you can figure it out with your expertise. The cells which I was not able to convert to number are marked in yellow in the SBI sheet.

Customize SBI.xlsm
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Sorry, I made one small mistake. The appended sheet will be named SBI and the result of the code will be Bank.
Please refer this corrected link.
Corrected Customize SBI.xlsm
 
Last edited:
Upvote 0
The following code is code to combine all of the 'Table' sheets into one sheet called 'SBI'.
Test it out to make sure it is working properly.

If it is working properly, it should be ready for processing with the other code.

VBA Code:
Option Explicit

Sub CombineSheets()
'
    Dim SheetRow                As Long
    Dim StartRow                As Long
    Dim LastColumnInSheet       As String
    Dim NewSheetName            As String
    Dim OriginalSourceSheet     As Worksheet
    Dim DestinationSheet        As Worksheet
    Dim ws                      As Worksheet
'
    Set OriginalSourceSheet = Worksheets("Table 1")                                             ' <-- Set this to the sheet to use for the initial input data
    NewSheetName = "SBI"                                                                        ' <--- Set this to the NewSheetName
    StartRow = 2                                                                                ' <--- Set this to the starting row of data of Table 2 & beyond
'
    Sheets.Add(Before:=OriginalSourceSheet).Name = NewSheetName                                 ' Add new sheet before the sheet used for the initial input
    Set DestinationSheet = Sheets(NewSheetName)                                                 '
'
    With OriginalSourceSheet
        LastColumnInSheet = Split(Cells(1, (.Cells.Find("*", , xlFormulas, , _
                xlByColumns, xlPrevious).Column)).Address, "$")(1)                              '   Get LastColumnInSheet
'
        .Range("A3").EntireRow.Copy Destination:=DestinationSheet.Range("A1")                   '   Copy/Paste Header to new sheet
'
        .Range("A4:" & LastColumnInSheet & .Range("A" & _
                Rows.Count).End(xlUp).Row).Copy Destination:=DestinationSheet.Range("A2")       ' Copy/Paste Header to new sheet
    End With
'
    For Each ws In Worksheets                                                                   ' Loop through all sheets in the workbook
        If ws.Name <> NewSheetName And ws.Name <> "Table 1" And Left$(ws.Name, 5) = "Table" Then    '   If we find a sheet that we want then ...
            ws.Range("A2:" & LastColumnInSheet & ws.Range("A" & Rows.Count).End(xlUp).Row).Copy _
                    Destination:=DestinationSheet.Range("A" & DestinationSheet.Range("A" & _
                    Rows.Count).End(xlUp).Row + 1)                                              '   Copy the data to the DestinationSheet
        End If
    Next                                                                                        ' Loop back
'
    With DestinationSheet
        For SheetRow = .Cells(.Rows.Count, "A").End(xlUp).Row To StartRow Step -1               '   Loop backwards through the rows
            If Not IsDate(.Cells(SheetRow, 1)) Then .Cells(SheetRow, 1).EntireRow.Delete        '       If cell in used range of Column A is not a date then delete row
        Next                                                                                    '   Loop back
'
        .Columns("A:B").Replace What:="" & Chr(10) & "", Replacement:="", LookAt:=xlPart, _
                SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False   '   Remove LineFeeds from Dates in Columns A:B
'
        .Columns("A:B").NumberFormat = "dd-mm-yyyy"                                             '   Set Date format of new sheet Columns A:B to "dd-mm-yyyy"
    End With
'
    With DestinationSheet.UsedRange                                                             '   Format all Columns on the new sheet
        .Columns.Font.Name = "Calibri"
        .Columns.Font.Size = 11
        .WrapText = False
        .Columns.AutoFit
        .Rows.AutoFit
    End With
End Sub
 
Upvote 0
👏👏👏 I didn't expect the code to be so short. It worked perfectly. Even the Bank clean data code is working fine. Will test with the 23 pages and let you know in sometime.
 
Upvote 0
More than 3500 rows customized in less than 5 seconds. One thing more, I added the line call Bank_CleanDataV3 at the end of combine sheets before end sub and got that also right.
 
Upvote 0
Glad to help.

My goodness! This might be the shortest thread you have ever had. :ROFLMAO:
 
Upvote 0
Glad to help.

My goodness! This might be the shortest thread you have ever had. :ROFLMAO:
Both the thread today were surprisingly short. I think I am getting the grip of explaining my query better.
 
Upvote 0
More than 3500 rows customized in less than 5 seconds. One thing more, I added the line call Bank_CleanDataV3 at the end of combine sheets before end sub and got that also right.

This could be about 1/3 faster. I eliminated 1 loop & included ScreenUpdating toggle:

VBA Code:
Option Explicit

Sub CombineSheetsV2()                                                                           ' 0.1046875 average seconds
'
    Dim StartTime               As Double
    StartTime = Timer
'
    Dim SheetRow                As Long
    Dim StartRow                As Long
    Dim LastColumnInSheet       As String
    Dim NewSheetName            As String
    Dim OriginalSourceSheet     As Worksheet
    Dim DestinationSheet        As Worksheet
    Dim ws                      As Worksheet
'
    Application.ScreenUpdating = False                                                          ' Turn ScreenUpdating Off
'
    Set OriginalSourceSheet = Worksheets("Table 1")                                             ' <-- Set this to the sheet to use for the initial input data
    NewSheetName = "SBI"                                                                        ' <--- Set this to the NewSheetName
    StartRow = 2                                                                                ' <--- Set this to the starting row of data of Table 2 & beyond
'
    Sheets.Add(Before:=OriginalSourceSheet).Name = NewSheetName                                 ' Add new sheet before the sheet used for the initial input
    Set DestinationSheet = Sheets(NewSheetName)                                                 '
'
    With OriginalSourceSheet
        LastColumnInSheet = Split(Cells(1, (.Cells.Find("*", , xlFormulas, , _
                xlByColumns, xlPrevious).Column)).Address, "$")(1)                              '   Get LastColumnInSheet
'
        .Range("A3").EntireRow.Copy Destination:=DestinationSheet.Range("A1")                   '   Copy/Paste Header to new sheet
'
        .Range("A4:" & LastColumnInSheet & .Range("A" & _
                Rows.Count).End(xlUp).Row).Copy Destination:=DestinationSheet.Range("A2")       ' Copy/Paste Header to new sheet
    End With
'
    For Each ws In Worksheets                                                                   ' Loop through all sheets in the workbook
        If ws.Name <> NewSheetName And ws.Name <> "Table 1" And Left$(ws.Name, 5) = "Table" Then    '   If we find a sheet that we want then ...
            ws.Range("A2:" & LastColumnInSheet & ws.Range("A" & Rows.Count).End(xlUp).Row).Copy _
                    Destination:=DestinationSheet.Range("A" & DestinationSheet.Range("A" & _
                    Rows.Count).End(xlUp).Row + 1)                                              '   Copy the data to the DestinationSheet
        End If
    Next                                                                                        ' Loop back
'
    With DestinationSheet
        .Columns("A:B").Replace What:="" & Chr(10) & "", Replacement:="", LookAt:=xlPart, _
                SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False   '   Remove LineFeeds from Dates in Columns A:B
'
        .Range("A2", .Cells(.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeConstants, _
                xlTextValues).EntireRow.Delete                                                  '   If cell in Column A is text, delete the row
'
        .Columns("A:B").NumberFormat = "dd-mm-yyyy"                                             '   Set Date format of new sheet Columns A:B to "dd-mm-yyyy"
    End With
'
    With DestinationSheet.UsedRange                                                             '   Format all Columns on the new sheet
        .Columns.Font.Name = "Calibri"
        .Columns.Font.Size = 11
        .WrapText = False
        .Columns.AutoFit
        .Rows.AutoFit
    End With
'
    Application.ScreenUpdating = True                                                           ' Turn ScreenUpdating back on
'
    Debug.Print "Time to Complete = " & Timer - StartTime & " Seconds."                         ' Display Elapsed time to Immediate window (CTRL+G)
End Sub
 
Upvote 0
This could be about 1/3 faster.
You are really crazy man. That makes 2 of us. I also don't like to give up when there is a possibility for improvement.
The code is giving the result in 3 seconds. I will have to calculate what is 1/3 faster than that.😉
 
Upvote 0

Forum statistics

Threads
1,215,465
Messages
6,124,980
Members
449,201
Latest member
Lunzwe73

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top