?
Solved

Splitting VBA to specific requirements

Posted on 2012-08-20
3
Medium Priority
?
430 Views
Last Modified: 2012-08-20
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

0
Comment
Question by:Shums
  • 3
3 Comments
 
LVL 28

Author Comment

by:Shums
ID: 38313765
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.
0
 
LVL 28

Accepted Solution

by:
Shums earned 0 total points
ID: 38314037
Hi Experts,

I found the solution myself see below code if I am correct:
Sub FullSummary()

Dim LastRow1 As Long
Dim LastRow2 As Long
Dim ws As Worksheet, wsR 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"), Key2:=Range("H2"), 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
    
    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 vbNo
    content.Parent.Close False
    Application.DisplayAlerts = True
    Exit Sub
    Case vbYes
        
    '-- 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
    
    DoEvents
    content.Activate
    
    '-- 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

    '-- 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
    Exit Sub
    End Select
    Application.DisplayAlerts = True
        
End Sub

Open in new window

0
 
LVL 28

Author Closing Comment

by:Shums
ID: 38314053
Thanks EE to teach me VBA Code, I am still beginner, I need your guidance. Thank You All.
0

Featured Post

Upgrade your Question Security!

Add Premium security features to your question to ensure its privacy or anonymity. Learn more about your ability to control Question Security today.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.

831 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question