asked on

Splitting VBA to specific requirements

Hello Experts,

I got below code with the help of one of the expert(Akoster) on EE. I would like to split below code. Below Codes results out data only for Revenue & Other Revenue, is it possible I would get the full data before getting only Revenue & Other Revenue? Then I would like to have a msgbox vbyesno, if yes then result out data only for revenue & other revenue, if no then exit sub.

Sub FileExtract()
Dim LastRow1 As Long
Dim LastRow2 As Long
Dim ws As Worksheet
Dim content As Worksheet
Dim result As String
Dim data_range As String
Dim strTemp As String

    Application.DisplayAlerts = False
    
    '-- this code is placed in a module, so first make sure that we are working on the summary sheet.
    Set ws = Worksheets("summary")
    ws.Select
    
    ws.Cells(ws.Rows.Count, "H").End(xlUp).Font.bold = False
    ws.Cells(ws.Rows.Count, "I").End(xlUp).Font.bold = False
    ws.Cells(ws.Rows.Count, "J").End(xlUp).Font.bold = False
    
    '-- clear data cells
    data_range = Replace(ws.UsedRange.Address, "$A$1", "A5")
    Range(data_range).ClearContents
    
    '-- select data file
    result = Application.GetOpenFilename(FileFilter:="Monthly Data files, *.txt", Title:="Please Select A File")
    If result <> CStr(False) Then Workbooks.OpenText filename:=result _
        , Origin:=437, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array( _
        Array(0, 1), Array(40, 1), Array(46, 1), Array(52, 1), Array(56, 1), _
        Array(64, 1), Array(68, 1), Array(98, 1), Array(111, 1), Array(124, 1), Array(137, 1), _
        Array(142, 1), Array(155, 1), Array(160, 1), Array(185, 1), Array(191, 1), Array(199, 1), _
        Array(224, 1), Array(227, 1), Array(231, 1), Array(234, 1), Array(238, 1), Array(240, 1), _
        Array(245, 1), Array(247, 1), Array(261, 1), Array(270, 1), Array(290, 1), Array(296, 1), _
        Array(309, 1), Array(321, 1), Array(332, 1), Array(336, 1), Array(341, 1), Array(344, 1), _
        Array(386, 1), Array(408, 1), Array(472, 1), Array(526, 1), Array(536, 1), Array(576, 1), _
        Array(599, 1), Array(645, 1), Array(666, 1)), TrailingMinusNumbers:=True
    DoEvents
    Set content = Workbooks(Mid(result, InStrRev(result, "\") + 1)).ActiveSheet
    strTemp = Mid$(result, InStrRev(result, "\") + 1)
    
    '-- add headers
    content.Range("A1").EntireRow.Insert
    content.Range("F:F").Insert
    content.Range("C1") = "Corp"
    content.Range("D1") = "Area"
    content.Range("E1") = "Acct"
    content.Range("F1") = "Type"
    content.Range("G1") = "PCNT"
    content.Range("N1") = "Cust.No."
    content.Range("M1") = "Net"
    content.Range("P1") = "Inv.No."
    content.Range("AJ1") = "Vessels"
    content.Range("AJ1") = "Type"
    
    '-- remove totals from column AJ
    content.Columns("AJ:AJ").AutoFilter
    content.Rows("1:1").AutoFilter field:=1, Criteria1:="=*total*", Operator:=xlAnd
    content.UsedRange.Offset(1).Delete shift:=xlUp
    content.Rows("1:1").AutoFilter
    
    '-- insert account type lookup formulae
    LastRow1 = Cells(Rows.Count, "P").End(xlUp).Row
    content.Range("F2:F" & LastRow1).Formula = "=VLOOKUP(RC[-1],'[CommCalc.xls]Account-Type'!C1:C2,2,0)"
    content.Range("F:F").Copy
    content.Range("F:F").PasteSpecial xlPasteValues
    
    '-- find zero values
    content.Range("M2:M" & LastRow1).Formula = "=IF(RC[-3]=0,RC[-4],IF(RC[-3]>0,RC[-3],""""))"
    content.Range("M:M").Copy
    content.Range("M:M").PasteSpecial xlPasteValues
        
    '-- remove zero values from column M
    content.Columns("M:M").AutoFilter
    content.Rows("1:1").AutoFilter field:=1, Criteria1:="=0", Operator:=xlAnd
    content.UsedRange.Offset(1).Delete shift:=xlUp
    content.Rows("1:1").AutoFilter
    
    '-- sort data
    content.UsedRange.Sort Key1:=Range("F2"), Order1:=xlAscending, Header:=xlYes
           
    '-- sort data by vessels
    content.UsedRange.Sort Key1:=Range("H2"), Order1:=xlAscending, Header:=xlYes
    
    '-- keep only revenue types
    content.Rows("1:1").AutoFilter
    content.Rows("1:1").AutoFilter field:=6, Criteria1:="<>*revenue*", Operator:=xlAnd
    content.UsedRange.Offset(1).Delete shift:=xlUp
    content.Rows("1:1").AutoFilter
    
    '-- delete other revenue types
    content.Rows("1:1").AutoFilter
    content.Rows("1:1").AutoFilter field:=6, Criteria1:="OTHER REVENUE"
    content.UsedRange.Offset(1).Delete shift:=xlUp
    content.Rows("1:1").AutoFilter

    '-- add vessel name row
    content.Range("AV2:AV" & LastRow1).Formula = "=CONCATENATE(RC[-12],RC[-11],RC[-10],RC[-9],RC[-8],RC[-7],RC[-6],RC[-5],RC[-4],RC[-3],RC[-2])"
    content.Columns("AV").Copy
    content.Columns("AV").PasteSpecial xlPasteValues

    '-- remove maintenance from column AV
    content.Columns("AV:AV").AutoFilter
    content.Rows("1:1").AutoFilter field:=1, Criteria1:="=*maintenance*", Operator:=xlAnd
    content.UsedRange.Offset(1).Delete shift:=xlUp
    content.Rows("1:1").AutoFilter
    
    '-- remove taut from column AV
    content.Columns("AV:AV").AutoFilter
    content.Rows("1:1").AutoFilter field:=1, Criteria1:="=*taut*", Operator:=xlAnd
    content.UsedRange.Offset(1).Delete shift:=xlUp
    content.Rows("1:1").AutoFilter

    '-- copy remaining data
    content.UsedRange.Offset(1).Columns(5).Copy
    ws.Range("B5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(3).Copy
    ws.Range("C5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(4).Copy
    ws.Range("D5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(7).Copy
    ws.Range("E5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(36).Copy
    ws.Range("F5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(6).Copy
    ws.Range("G5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(9).Copy
    ws.Range("H5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(10).Copy
    ws.Range("I5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(14).Copy
    ws.Range("K5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(16).Copy
    ws.Range("L5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(48).Copy
    ws.Range("M5").PasteSpecial xlValues
    
    '-- add function
    LastRow2 = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    ws.Range("A5").Formula = "1"
    ws.Range("A6").Formula = "=A5+1"
    ws.Range("A6").AutoFill ws.Range("A6:A" & LastRow2)
    ws.Range("A6:A" & LastRow2).Copy
    ws.Range("A6:A" & LastRow2).PasteSpecial xlValues
    ws.Range("J5:J" & LastRow2).Formula = "=I5-H5"
    ws.Range("J5:J" & LastRow2).Copy
    ws.Range("J5:J" & LastRow2).PasteSpecial xlValues
    ws.Range("H" & LastRow2 + 2).Formula = "=SUBTOTAL(9,H5:H" & LastRow2 & ")"
    ws.Range("H" & LastRow2 + 2).Font.bold = True
    ws.Range("I" & LastRow2 + 2).Formula = "=SUBTOTAL(9,I5:I" & LastRow2 & ")"
    ws.Range("I" & LastRow2 + 2).Font.bold = True
    ws.Range("J" & LastRow2 + 2).Formula = "=SUBTOTAL(9,J5:J" & LastRow2 & ")"
    ws.Range("J" & LastRow2 + 2).Font.bold = True
    ws.Range("F4:F" & LastRow2).Replace What:="Charter hire of ", Replacement:="", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    '-- close data file
    content.Parent.Close False
    ws.AutoFilterMode = False
    Application.Goto ws.Range("A5:A" & LastRow2), True
    ws.Range("B3") = Left$(strTemp, InStrRev(strTemp, ".") - 1)
    ws.Columns("A:A").EntireColumn.AutoFit
    ws.Columns("F:F").EntireColumn.AutoFit
    ws.Cells(ws.Rows.Count, "J").End(xlUp).Select
    Application.DisplayAlerts = True
        
End Sub

Open in new window

Shums Faruk

ASKER

Hello Experts,

I simply tried as below code and works perfect, but after msgbox vbyes, I don't want it to run again the same way of opening the text file, can we incorporate in just one code, please help to shorten this code:

Sub FullSummary()

Dim LastRow1 As Long
Dim LastRow2 As Long
Dim ws As Worksheet
Dim content As Worksheet
Dim result As String
Dim data_range As String
Dim ReturnValue As Integer
Dim strTemp As String

    Application.DisplayAlerts = False
    
    '-- this code is placed in a module, so first make sure that we are working on the summary sheet.
    Set ws = Worksheets("Summary")
    ws.Select
    
    ws.Cells(ws.Rows.Count, "H").End(xlUp).Font.bold = False
    ws.Cells(ws.Rows.Count, "I").End(xlUp).Font.bold = False
    ws.Cells(ws.Rows.Count, "J").End(xlUp).Font.bold = False
    
    '-- clear data cells
    data_range = Replace(ws.UsedRange.Address, "$A$1", "A5")
    Range(data_range).ClearContents
    
    '-- select data file
    result = Application.GetOpenFilename(FileFilter:="Monthly Data files, *.txt", Title:="Please Select A File")
    If result <> CStr(False) Then Workbooks.OpenText filename:=result _
        , Origin:=437, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array( _
        Array(0, 1), Array(40, 1), Array(46, 1), Array(52, 1), Array(56, 1), _
        Array(64, 1), Array(68, 1), Array(98, 1), Array(111, 1), Array(124, 1), Array(137, 1), _
        Array(142, 1), Array(155, 1), Array(160, 1), Array(185, 1), Array(191, 1), Array(199, 1), _
        Array(224, 1), Array(227, 1), Array(231, 1), Array(234, 1), Array(238, 1), Array(240, 1), _
        Array(245, 1), Array(247, 1), Array(261, 1), Array(270, 1), Array(290, 1), Array(296, 1), _
        Array(309, 1), Array(321, 1), Array(332, 1), Array(336, 1), Array(341, 1), Array(344, 1), _
        Array(386, 1), Array(401, 1)), TrailingMinusNumbers:=True
    DoEvents
    Set content = Workbooks(Mid(result, InStrRev(result, "\") + 1)).ActiveSheet
    strTemp = Mid$(result, InStrRev(result, "\") + 1)
    
    '-- add headers
    content.Range("A1").EntireRow.Insert
    content.Range("F:F").Insert
    content.Range("C1") = "Corp"
    content.Range("D1") = "Area"
    content.Range("E1") = "Acct"
    content.Range("F1") = "Type"
    content.Range("G1") = "PCNT"
    content.Range("N1") = "Cust.No."
    content.Range("M1") = "Net"
    content.Range("P1") = "Inv.No."
    content.Range("AJ1") = "Vessels"
    
    '-- remove unwanted text
    content.Columns("AJ:AJ").Replace What:="=- ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    
    '-- remove totals from column AK
    content.Columns("AK:AK").AutoFilter
    content.Rows("1:1").AutoFilter Field:=1, Criteria1:="=*total*", Operator:=xlAnd
    content.UsedRange.Offset(1).Delete Shift:=xlUp
    content.Rows("1:1").AutoFilter
    
    '-- insert account type lookup formulae
    
    LastRow1 = Cells(Rows.Count, "P").End(xlUp).Row
    content.Range("F2:F" & LastRow1).Formula = "=VLOOKUP(RC[-1],'[CommCalc(1).xls]Account-Type'!C1:C2,2,0)"
    content.Range("F:F").Copy
    content.Range("F:F").PasteSpecial xlPasteValues
    
    '-- find zero values
    content.Range("M2:M" & LastRow1).Formula = "=IF(RC[-3]=0,RC[-4],IF(RC[-3]>0,RC[-3],""""))"
    content.Range("M:M").Copy
    content.Range("M:M").PasteSpecial xlPasteValues
        
    '-- remove zero values from column M
    content.Columns("M:M").AutoFilter
    content.Rows("1:1").AutoFilter Field:=1, Criteria1:="=0", Operator:=xlAnd
    content.UsedRange.Offset(1).Delete Shift:=xlUp
    content.Rows("1:1").AutoFilter
    
    '-- sort data
    content.UsedRange.Sort Key1:=Range("F2"), Order1:=xlAscending, Header:=xlYes
           
    '-- add vessel name row
    content.Range("AV2:AV" & LastRow1).Formula = "=CONCATENATE(RC[-12],RC[-11],RC[-10],RC[-9],RC[-8],RC[-7],RC[-6],RC[-5],RC[-4],RC[-3],RC[-2])"
    content.Columns("AV").Copy
    content.Columns("AV").PasteSpecial xlPasteValues

    '-- remove maintenance from column AV
    content.Columns("AV:AV").AutoFilter
    content.Rows("1:1").AutoFilter Field:=1, Criteria1:="=*maintenance*", Operator:=xlAnd
    content.UsedRange.Offset(1).Delete Shift:=xlUp
    content.Rows("1:1").AutoFilter
    
    '-- remove taut from column AV
    content.Columns("AV:AV").AutoFilter
    content.Rows("1:1").AutoFilter Field:=1, Criteria1:="=*taut*", Operator:=xlAnd
    content.UsedRange.Offset(1).Delete Shift:=xlUp
    content.Rows("1:1").AutoFilter

    '-- copy remaining data
    content.UsedRange.Offset(1).Columns(5).Copy
    ws.Range("B5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(3).Copy
    ws.Range("C5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(4).Copy
    ws.Range("D5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(7).Copy
    ws.Range("E5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(36).Copy
    ws.Range("F5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(6).Copy
    ws.Range("G5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(9).Copy
    ws.Range("H5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(10).Copy
    ws.Range("I5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(14).Copy
    ws.Range("K5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(16).Copy
    ws.Range("L5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(48).Copy
    ws.Range("M5").PasteSpecial xlValues
    
    '-- add function
    LastRow2 = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    ws.Range("A5").Formula = "1"
    ws.Range("A6").Formula = "=A5+1"
    ws.Range("A6").AutoFill ws.Range("A6:A" & LastRow2)
    ws.Range("A6:A" & LastRow2).Copy
    ws.Range("A6:A" & LastRow2).PasteSpecial xlValues
    ws.Range("J5:J" & LastRow2).Formula = "=I5-H5"
    ws.Range("J5:J" & LastRow2).Copy
    ws.Range("J5:J" & LastRow2).PasteSpecial xlValues
    ws.Range("H" & LastRow2 + 2).Formula = "=SUBTOTAL(9,H5:H" & LastRow2 & ")"
    ws.Range("H" & LastRow2 + 2).Font.bold = True
    ws.Range("I" & LastRow2 + 2).Formula = "=SUBTOTAL(9,I5:I" & LastRow2 & ")"
    ws.Range("I" & LastRow2 + 2).Font.bold = True
    ws.Range("J" & LastRow2 + 2).Formula = "=SUBTOTAL(9,J5:J" & LastRow2 & ")"
    ws.Range("J" & LastRow2 + 2).Font.bold = True
    ws.Range("F4:F" & LastRow2).Replace What:="Charter hire of ", Replacement:="", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    '-- close data file
    content.Parent.Close False
    ws.AutoFilterMode = False
    Application.Goto ws.Range("A5:A" & LastRow2), True
    ws.Range("B3") = Left$(strTemp, InStrRev(strTemp, ".") - 1)
    ws.Columns("A:A").EntireColumn.AutoFit
    ws.Columns("F:F").EntireColumn.AutoFit
    ws.Columns("G:G").EntireColumn.AutoFit
    ws.Cells(ws.Rows.Count, "J").End(xlUp).Select
    ReturnValue = MsgBox("Do You Want Revenue Summary", vbYesNo)
    Select Case ReturnValue
    Case vbYes
    Call RevenueSummary
    Case vbNo
    Exit Sub
    End Select
    
End Sub

Sub RevenueSummary()

Dim LastRow1 As Long
Dim LastRow2 As Long
Dim wsR As Worksheet
Dim content As Worksheet
Dim result As String
Dim data_range As String
Dim strTemp As String

    Application.DisplayAlerts = False
    
    '-- this code is placed in a module, so first make sure that we are working on the summary sheet.
    Set wsR = Worksheets("Revenue_Summary")
    wsR.Select
    
    wsR.Cells(wsR.Rows.Count, "H").End(xlUp).Font.bold = False
    wsR.Cells(wsR.Rows.Count, "I").End(xlUp).Font.bold = False
    wsR.Cells(wsR.Rows.Count, "J").End(xlUp).Font.bold = False
    
    '-- clear data cells
    data_range = Replace(wsR.UsedRange.Address, "$A$1", "A5")
    Range(data_range).ClearContents
    
    '-- select data file
    result = Application.GetOpenFilename(FileFilter:="Monthly Data files, *.txt", Title:="Please Select A File")
    If result <> CStr(False) Then Workbooks.OpenText filename:=result _
        , Origin:=437, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array( _
        Array(0, 1), Array(40, 1), Array(46, 1), Array(52, 1), Array(56, 1), _
        Array(64, 1), Array(68, 1), Array(98, 1), Array(111, 1), Array(124, 1), Array(137, 1), _
        Array(142, 1), Array(155, 1), Array(160, 1), Array(185, 1), Array(191, 1), Array(199, 1), _
        Array(224, 1), Array(227, 1), Array(231, 1), Array(234, 1), Array(238, 1), Array(240, 1), _
        Array(245, 1), Array(247, 1), Array(261, 1), Array(270, 1), Array(290, 1), Array(296, 1), _
        Array(309, 1), Array(321, 1), Array(332, 1), Array(336, 1), Array(341, 1), Array(344, 1), _
        Array(386, 1), Array(408, 1), Array(472, 1), Array(526, 1), Array(536, 1), Array(576, 1), _
        Array(599, 1), Array(645, 1), Array(666, 1)), TrailingMinusNumbers:=True
    DoEvents
    Set content = Workbooks(Mid(result, InStrRev(result, "\") + 1)).ActiveSheet
    strTemp = Mid$(result, InStrRev(result, "\") + 1)
    
    '-- add headers
    content.Range("A1").EntireRow.Insert
    content.Range("F:F").Insert
    content.Range("C1") = "Corp"
    content.Range("D1") = "Area"
    content.Range("E1") = "Acct"
    content.Range("F1") = "Type"
    content.Range("G1") = "PCNT"
    content.Range("N1") = "Cust.No."
    content.Range("M1") = "Net"
    content.Range("P1") = "Inv.No."
    content.Range("AJ1") = "Vessels"
        
    '-- remove totals from column AJ
    content.Columns("AJ:AJ").AutoFilter
    content.Rows("1:1").AutoFilter Field:=1, Criteria1:="=*total*", Operator:=xlAnd
    content.UsedRange.Offset(1).Delete Shift:=xlUp
    content.Rows("1:1").AutoFilter
    
    '-- insert account type lookup formulae
    LastRow1 = Cells(Rows.Count, "P").End(xlUp).Row
    content.Range("F2:F" & LastRow1).Formula = "=VLOOKUP(RC[-1],'[CommCalc(1).xls]Account-Type'!C1:C2,2,0)"
    content.Range("F:F").Copy
    content.Range("F:F").PasteSpecial xlPasteValues
    
    '-- find zero values
    content.Range("M2:M" & LastRow1).Formula = "=IF(RC[-3]=0,RC[-4],IF(RC[-3]>0,RC[-3],""""))"
    content.Range("M:M").Copy
    content.Range("M:M").PasteSpecial xlPasteValues
        
    '-- remove zero values from column M
    content.Columns("M:M").AutoFilter
    content.Rows("1:1").AutoFilter Field:=1, Criteria1:="=0", Operator:=xlAnd
    content.UsedRange.Offset(1).Delete Shift:=xlUp
    content.Rows("1:1").AutoFilter
    
    '-- sort data
    content.UsedRange.Sort Key1:=Range("F2"), Order1:=xlAscending, Header:=xlYes
           
    '-- sort data by vessels
    content.UsedRange.Sort Key1:=Range("H2"), Order1:=xlAscending, Header:=xlYes
    
    '-- keep only revenue types
    content.Rows("1:1").AutoFilter
    content.Rows("1:1").AutoFilter Field:=6, Criteria1:="<>*revenue*", Operator:=xlAnd
    content.UsedRange.Offset(1).Delete Shift:=xlUp
    content.Rows("1:1").AutoFilter
    
    '-- delete other revenue types
    content.Rows("1:1").AutoFilter
    content.Rows("1:1").AutoFilter Field:=6, Criteria1:="OTHER REVENUE"
    content.UsedRange.Offset(1).Delete Shift:=xlUp
    content.Rows("1:1").AutoFilter

    '-- add vessel name row
    content.Range("AV2:AV" & LastRow1).Formula = "=CONCATENATE(RC[-12],RC[-11],RC[-10],RC[-9],RC[-8],RC[-7],RC[-6],RC[-5],RC[-4],RC[-3],RC[-2])"
    content.Columns("AV").Copy
    content.Columns("AV").PasteSpecial xlPasteValues

    '-- remove maintenance from column AV
    content.Columns("AV:AV").AutoFilter
    content.Rows("1:1").AutoFilter Field:=1, Criteria1:="=*maintenance*", Operator:=xlAnd
    content.UsedRange.Offset(1).Delete Shift:=xlUp
    content.Rows("1:1").AutoFilter
    
    '-- remove taut from column AV
    content.Columns("AV:AV").AutoFilter
    content.Rows("1:1").AutoFilter Field:=1, Criteria1:="=*taut*", Operator:=xlAnd
    content.UsedRange.Offset(1).Delete Shift:=xlUp
    content.Rows("1:1").AutoFilter

    '-- copy remaining data
    content.UsedRange.Offset(1).Columns(5).Copy
    wsR.Range("B5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(3).Copy
    wsR.Range("C5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(4).Copy
    wsR.Range("D5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(7).Copy
    wsR.Range("E5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(36).Copy
    wsR.Range("F5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(6).Copy
    wsR.Range("G5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(9).Copy
    wsR.Range("H5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(10).Copy
    wsR.Range("I5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(14).Copy
    wsR.Range("K5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(16).Copy
    wsR.Range("L5").PasteSpecial xlValues
    content.UsedRange.Offset(1).Columns(48).Copy
    wsR.Range("M5").PasteSpecial xlValues
    
    '-- add function
    LastRow2 = wsR.Cells(wsR.Rows.Count, "B").End(xlUp).Row
    wsR.Range("A5").Formula = "1"
    wsR.Range("A6").Formula = "=A5+1"
    wsR.Range("A6").AutoFill wsR.Range("A6:A" & LastRow2)
    wsR.Range("A6:A" & LastRow2).Copy
    wsR.Range("A6:A" & LastRow2).PasteSpecial xlValues
    wsR.Range("J5:J" & LastRow2).Formula = "=I5-H5"
    wsR.Range("J5:J" & LastRow2).Copy
    wsR.Range("J5:J" & LastRow2).PasteSpecial xlValues
    wsR.Range("H" & LastRow2 + 2).Formula = "=SUBTOTAL(9,H5:H" & LastRow2 & ")"
    wsR.Range("H" & LastRow2 + 2).Font.bold = True
    wsR.Range("I" & LastRow2 + 2).Formula = "=SUBTOTAL(9,I5:I" & LastRow2 & ")"
    wsR.Range("I" & LastRow2 + 2).Font.bold = True
    wsR.Range("J" & LastRow2 + 2).Formula = "=SUBTOTAL(9,J5:J" & LastRow2 & ")"
    wsR.Range("J" & LastRow2 + 2).Font.bold = True
    wsR.Range("F4:F" & LastRow2).Replace What:="Charter hire of ", Replacement:="", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    '-- close data file
    content.Parent.Close False
    wsR.AutoFilterMode = False
    Application.Goto wsR.Range("A5:A" & LastRow2), True
    wsR.Range("B3") = Left$(strTemp, InStrRev(strTemp, ".") - 1)
    wsR.Columns("A:A").EntireColumn.AutoFit
    wsR.Columns("F:F").EntireColumn.AutoFit
    wsR.Cells(wsR.Rows.Count, "J").End(xlUp).Select
    Application.DisplayAlerts = True
        
End Sub

Open in new window

Thank you in advance.

ASKER CERTIFIED SOLUTION

Shums Faruk

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Shums Faruk

ASKER

Thanks EE to teach me VBA Code, I am still beginner, I need your guidance. Thank You All.