XLA routines: EE_RangeSubtract
Use EE_RangeSubtract to subtract a range from another
Public Function EE_RangeSubtract(ByVal rng1 As range, ByVal rng2 As range) As range Dim rngSmall As range Dim rngBig As range Dim rngIntersect As range Dim rngTopRows As range Dim rngBtmRows As range Dim rngLeftCols As range Dim rngRightCols As range Dim rngUnion As range Dim strMsg As String 'http://excelexperts.com/xla-routines-eeRangeSubtract for updates on this function If rng1.Areas.Count > 1 Or rng2.Areas.Count > 1 Then strMsg = "Both the ranges should be rectangular." GoTo ErrH ElseIf rng1.Address = rng2.Address Then strMsg = "Both ranges are equal." GoTo ErrH Else If EE_GetCellCount(rng1) < EE_GetCellCount(rng2) Then Set rngSmall = rng1 Set rngBig = rng2 Else Set rngSmall = rng2 Set rngBig = rng1 End If End If On Error Resume Next Set rngIntersect = Intersect(rngSmall, rngBig) On Error GoTo 0 If rngIntersect Is Nothing Then strMsg = "No common area in two ranges" GoTo ErrH Else If rngIntersect.Address <> rngSmall.Address Then Set rngSmall = rngIntersect End If 'Top Rows If rngBig.Rows(1).Row <> rngSmall.Rows(1).Row Then Set rngTopRows = rngBig.Rows(1).Resize(rngSmall.Rows(1).Row - rngBig.Rows(1).Row) Call EE_AppendToRange(rngUnion, rngTopRows) End If 'Bottom Rows If rngBig.Rows(rngBig.Rows.Count).Row <> rngSmall.Rows(rngSmall.Rows.Count).Row Then Set rngBtmRows = rngBig.Rows(rngSmall.Rows(rngSmall.Rows.Count).Row - rngBig.Rows(1).Row + 2).Resize(rngBig.Rows(rngBig.Rows.Count).Row - rngSmall.Rows(rngSmall.Rows.Count).Row) Call EE_AppendToRange(rngUnion, rngBtmRows) End If 'Left Colums If rngBig.Columns(1).Column <> rngSmall.Columns(1).Column Then Set rngLeftCols = rngBig.Columns(1).Resize(, rngSmall.Columns(1).Column - rngBig.Columns(1).Column) Call EE_AppendToRange(rngUnion, rngLeftCols) End If 'Right Columns If rngBig.Columns(rngBig.Columns.Count).Column <> rngSmall.Columns(rngSmall.Columns.Count).Column Then Set rngRightCols = rngBig.Columns(rngSmall.Columns(rngSmall.Columns.Count).Column - rngBig.Columns(1).Column + 2).Resize(, rngBig.Columns(rngBig.Columns.Count).Column - rngSmall.Columns(rngSmall.Columns.Count).Column) Call EE_AppendToRange(rngUnion, rngRightCols) End If End If Set EE_RangeSubtract = rngUnion GoTo ExitH ErrH: Set EE_RangeSubtract = Nothing ExitH: Set rngSmall = Nothing Set rngBig = Nothing Set rngIntersect = Nothing Set rngTopRows = Nothing Set rngBtmRows = Nothing Set rngLeftCols = Nothing Set rngRightCols = Nothing Set rngUnion = Nothing End Function Private Sub EE_AppendToRange(rngAppendTo As range, rngAppend As range) If Not rngAppendTo Is Nothing Then Set rngAppendTo = Union(rngAppendTo, rngAppend) Else Set rngAppendTo = rngAppend End If End Sub
»
- Nick's blog
- Login or register to post comments
- 2677 reads
Recent comments
5 years 34 weeks ago
6 years 20 weeks ago
6 years 32 weeks ago
6 years 35 weeks ago
6 years 36 weeks ago
6 years 42 weeks ago
6 years 50 weeks ago
6 years 50 weeks ago
6 years 50 weeks ago
6 years 50 weeks ago