PDA

View Full Version : Unexpected Behavior of VBA Code



Shums
08-22-2012, 01:59 PM
Hi All,

I thought I reached my goal, but if I change raw data for previous months, this VBA does unexpected behavior for Subtotal in Sheet CabGoc; , Please see below code and correct me, where I am overlapping for Subtotal.

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 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

'-- 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

'-- this code is placed in a module, so first make sure that we are working on the Revenue sheet.
Set wsR = Worksheets("Revenue_Summary")
Set wsC = Worksheets("CABGOC")
Set wsNC = Worksheets("NON-CABGOC")
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 for Revenue_Summary
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

'-- 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)
wsC.Range("B3") = Left$(strTemp, InStrRev(strTemp, ".") - 1)
wsNC.Range("B3") = Left$(strTemp, InStrRev(strTemp, ".") - 1)
wsR.Columns("A:A").EntireColumn.AutoFit
wsR.Columns("F:F").EntireColumn.AutoFit
Call SearchForCabGoc
wsR.Activate
wsR.Cells(wsR.Rows.Count, "J").End(xlUp).Select
Application.DisplayAlerts = True

End Sub
Sub SearchForCabGoc()

Dim LSearchRow As Integer
Dim LCopyToRow As Integer
Dim LastRow3 As Long
Dim CabGocRange As String

Sheets("CABGOC").Select
LastRow3 = Sheets("CABGOC").Cells(Sheets("CABGOC").Rows.Count, "B").End(xlUp).Row
Sheets("CABGOC").Cells(Sheets("CABGOC").Rows.Count, "G").End(xlUp).Font.bold = False
Sheets("CABGOC").Cells(Sheets("CABGOC").Rows.Count, "H").End(xlUp).Font.bold = False
CabGocRange = Replace(Sheets("CABGOC").UsedRange.Address, "$A$1", "A5")
Range(CabGocRange).ClearContents

Sheets("Revenue_Summary").Select

On Error GoTo Err_Execute

'Start search in row 5
LSearchRow = 5

'Start copying data to row 5 in CABGOC (row counter variable)
LCopyToRow = 5

While Len(Range("A" & CStr(LSearchRow)).Value) > 0

'If value in column K = "85175", copy entire row to CABGOC
If Range("K" & CStr(LSearchRow)).Value = "85175" Then

'Select row in Revenue_Summary to copy
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy

'Paste row into CABGOC in next row
Sheets("CABGOC").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste

'Append "1000"
Range("K" & LCopyToRow).Value = "1000" & Range("K" & LCopyToRow).Value

'Move counter to next row
LCopyToRow = LCopyToRow + 1

'Go back to Revenue_Summary to continue searching
Sheets("Revenue_Summary").Select

End If

LSearchRow = LSearchRow + 1

Wend

'Position on last cell
Sheets("CABGOC").Select
Sheets("CABGOC").Columns("G:I").Delete Shift:=xlToLeft
Sheets("CABGOC").Columns("H:H").EntireColumn.Insert Shift:=xlToRight
Sheets("CABGOC").Range("G4") = "Amt"
Sheets("CABGOC").Range("H4") = "Comm_Amt"
Sheets("CABGOC").Range("I4") = "Cust_No."
Sheets("CABGOC").Range("J4") = "Inv.No."
Sheets("CABGOC").Range("A5").Formula = "1"
Sheets("CABGOC").Range("A6").Formula = "=A5+1"
Sheets("CABGOC").Range("A6").AutoFill Sheets("CABGOC").Range("A6:A" & LastRow3)
Sheets("CABGOC").Range("A6:A" & LastRow3).Copy
Sheets("CABGOC").Range("A6:A" & LastRow3).PasteSpecial xlValues
Sheets("CABGOC").Range("H5:H" & LastRow3).Formula = "=RC[-1]*10%"
Sheets("CABGOC").Range("H5:H" & LastRow3).Copy
Sheets("CABGOC").Range("H5:H" & LastRow3).PasteSpecial xlValues
Sheets("CABGOC").Columns("K:K").Delete Shift:=xlToLeft
Sheets("CABGOC").Range("G" & LastRow3 + 2).Formula = "=SUBTOTAL(9,G5:G" & LastRow3 & ")"
Sheets("CABGOC").Range("G" & LastRow3 + 2).Font.bold = True
Sheets("CABGOC").Range("H" & LastRow3 + 2).Formula = "=SUBTOTAL(9,H5:H" & LastRow3 & ")"
Sheets("CABGOC").Range("H" & LastRow3 + 2).Font.bold = True
Sheets("CABGOC").Range("G:H").NumberFormat = "#,##0.00_);[Red](#,##0.00)"
Sheets("CABGOC").Rows("4:4").Font.bold = True
Sheets("CABGOC").Rows("4:4").HorizontalAlignment = xlCenter
Sheets("CABGOC").Rows("4:4").VerticalAlignment = xlCenter
Sheets("CABGOC").Columns("A:A").EntireColumn.AutoFit
Sheets("CABGOC").Columns("C:J").EntireColumn.AutoFit
Application.Goto Sheets("CABGOC").Range("A5:A" & LastRow3), True
Sheets("CABGOC").Cells(Sheets("CABGOC").Rows.Count, "H").End(xlUp).Select
Application.CutCopyMode = False
Call SearchForNonCabGoc
Exit Sub

Err_Execute:
MsgBox "An Error Occurred."

End Sub
Sub SearchForNonCabGoc()

Dim LSearchRow As Integer
Dim LCopyToRow As Integer
Dim LastRow4 As String
Dim NonCabGocRange As String

Sheets("NON-CABGOC").Select
LastRow4 = Sheets("NON-CABGOC").Cells(Sheets("NON-CABGOC").Rows.Count, "B").End(xlUp).Row
Sheets("NON-CABGOC").Cells(Sheets("NON-CABGOC").Rows.Count, "G").End(xlUp).Font.bold = False
Sheets("NON-CABGOC").Cells(Sheets("NON-CABGOC").Rows.Count, "H").End(xlUp).Font.bold = False
NonCabGocRange = Replace(Sheets("NON-CABGOC").UsedRange.Address, "$A$1", "A5")
Range(NonCabGocRange).ClearContents

Sheets("Revenue_Summary").Select

On Error GoTo Err_Execute

'Start search in row 5
LSearchRow = 5

'Start copying data to row 5 in NON-CABGOC (row counter variable)
LCopyToRow = 5

While Len(Range("A" & CStr(LSearchRow)).Value) > 0

'If value in column K <> "85175", copy entire row to NON-CABGOC
If Range("K" & CStr(LSearchRow)).Value <> "85175" Then

'Select row in Revenue_Summary to copy
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy

'Paste row into CABGOC in next row
Sheets("NON-CABGOC").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste

'Append "1000"
Range("K" & LCopyToRow).Value = "1000" & Range("K" & LCopyToRow).Value

'Move counter to next row
LCopyToRow = LCopyToRow + 1

'Go back to Revenue_Summary to continue searching
Sheets("Revenue_Summary").Select

End If

LSearchRow = LSearchRow + 1

Wend

'Position on last cell
Sheets("NON-CABGOC").Select
Sheets("NON-CABGOC").Columns("G:I").Delete Shift:=xlToLeft
Sheets("NON-CABGOC").Columns("H:H").EntireColumn.Insert Shift:=xlToRight
Sheets("NON-CABGOC").Range("G4") = "Amt"
Sheets("NON-CABGOC").Range("H4") = "Comm_Amt"
Sheets("NON-CABGOC").Range("I4") = "Cust_No."
Sheets("NON-CABGOC").Range("J4") = "Inv.No."
Sheets("NON-CABGOC").Range("A5").Formula = "1"
Sheets("NON-CABGOC").Range("A6").Formula = "=A5+1"
Sheets("NON-CABGOC").Range("A6").AutoFill Sheets("NON-CABGOC").Range("A6:A" & LastRow4)
Sheets("NON-CABGOC").Range("A6:A" & LastRow4).Copy
Sheets("NON-CABGOC").Range("A6:A" & LastRow4).PasteSpecial xlValues
Sheets("NON-CABGOC").Range("H5:H" & LastRow4).Formula = "=RC[-1]*10%"
Sheets("NON-CABGOC").Range("H5:H" & LastRow4).Copy
Sheets("NON-CABGOC").Range("H5:H" & LastRow4).PasteSpecial xlValues
Sheets("NON-CABGOC").Columns("K:K").Delete Shift:=xlToLeft
Sheets("NON-CABGOC").Range("G" & LastRow4 + 2).Formula = "=SUBTOTAL(9,G5:G" & LastRow4 & ")"
Sheets("NON-CABGOC").Range("G" & LastRow4 + 2).Font.bold = True
Sheets("NON-CABGOC").Range("H" & LastRow4 + 2).Formula = "=SUBTOTAL(9,H5:H" & LastRow4 & ")"
Sheets("NON-CABGOC").Range("H" & LastRow4 + 2).Font.bold = True
Sheets("NON-CABGOC").Range("G:H").NumberFormat = "#,##0.00_);[Red](#,##0.00)"
Sheets("NON-CABGOC").Rows("4:4").Font.bold = True
Sheets("NON-CABGOC").Rows("4:4").HorizontalAlignment = xlCenter
Sheets("NON-CABGOC").Rows("4:4").VerticalAlignment = xlCenter
Sheets("NON-CABGOC").Columns("A:A").EntireColumn.AutoFit
Sheets("NON-CABGOC").Columns("C:J").EntireColumn.AutoFit
Application.Goto Sheets("NON-CABGOC").Range("A5:A" & LastRow4), True
Sheets("NON-CABGOC").Cells(Sheets("NON-CABGOC").Rows.Count, "H").End(xlUp).Select
Application.CutCopyMode = False

MsgBox "All CABGOC & NON-CABGOC Customer Data Has Been Copied."

Exit Sub

Err_Execute:
MsgBox "An Error Occurred."

End Sub




Please help.....


Thanking You in advance......

CatDaddy
08-22-2012, 02:02 PM
what kind of unexpected behavior? and where are you having your error?

Shums
08-22-2012, 02:25 PM
Sir CatDaddy,

Welcome again.

Sometimes, subtotal will be placed in between the data in sheet cabgoc or sometimes, it takes off the column header and place subtotal in the second row, where its the same vba code for non-cabgoc, I don't have any problem there.

CatDaddy
08-23-2012, 07:41 AM
Did you try stepping through it? I feel like your value for LastRow4 is not getting assigned correctly