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
- 2716 reads
Recent comments
5 years 41 weeks ago
6 years 27 weeks ago
6 years 39 weeks ago
6 years 42 weeks ago
6 years 43 weeks ago
6 years 48 weeks ago
7 years 4 weeks ago
7 years 5 weeks ago
7 years 5 weeks ago
7 years 5 weeks ago