Excel VBA - Find a new Range based on the difference between two existing Ranges

Question

Project Outline: The project I'm working on consists of a file with 2 sheets. The first sheet is a Dashboard of Reports with inputs about who worked it, what department it was for, and the timeframe of each report. This information is then transferred to a second sheet via a Button.

Right now the button copies the data from Dashboard to Data, adding the new information, starting in the first blank row (counted up from the bottom) of Column B. It then requests a Date input for that data from the user.

What I want to happen next:

I need to find the Range based on where the last input from Column A is, to where the last input of Column B is.

Example: Say there is Data from A1:A345. Say there is also Data from B1:B764. I need the VBA script to pull the range A346:A764 so I can then tell it to apply the Date from the input box in Column A for that range. (The dates may be historical and/or out of order so the input from the user is important. )

---

I'm currently using :

• sh2.Cells(Rows.Count, 1).End(xlUp) - to Find the range of Column A

• sh2.Cells(Rows.Count, 2).End(xlUp) - to Find the range of Column B

I'm having trouble figuring out a way to compare on range to the other in order to return the correct range for the data.

I've attempted using:

• DO UNTIL (Excel crashed, it seems to loop continuously and I'm having trouble finding a way to get it to recognize when to stop)

  • DO UNTIL Attempt

 `sh2.Cells(Rows.Count, 1).End(xlUp)(2).Select
 Do Until IsEmpty(ActiveCell.Offset(, 1))
 sh2.Cells(Rows.Count, 1).End(xlUp)(2).Value = myDate
Loop`

• LOOP UNTIL (Excel crashed, same as above)

• FOR EACH with IF NOT (I can't quite figure out how to compare the ranges to return a usable value)

  • FOR EACH Attempt

 `Dim AColLR As Long
 Dim BColLR As Long
 Dim rngA As Range
 Dim rngB As Range
 Dim rngC As Range
 Dim cell As Range

 AColLR = sh2.Cells(Rows.Count, 1).End(xlUp).Row
 BColLR = sh2.Cells(Rows.Count, 2).End(xlUp).Row


'Set rngB = sh2.Range("B2:B" & BColLR)
Set rngC = sh2.Range(BColLR - AColLR)
For Each cell In rngC
If Not IsEmpty(cell.Value) Then
cell.Offset(, -1).Value = myDate
End If
Next cell`

• FUNCTION (I wasn't able to figure out how to call the function in the Sub, also Function might be broken?)

  • FUNCTION Attempt

`Function SetDifference(rngA As Range, rngB As Range) As Range
Dim sh1 As Worksheet, sh2 As Worksheet
Set sh1 = Sheets("Dashboard")
Set sh2 = Sheets("Data")
AColLR = sh2.Cells(Rows.Count, 1).End(xlUp).Row
BColLR = sh2.Cells(Rows.Count, 2).End(xlUp).Row
rngA = sh2.Range("A2:A" & AColLR)
rngB = sh2.Range("B2:B" & BColLR)
On Error Resume Next
If Intersect(rngA, rngB) Is Nothing Then
'if there is no common area then we will set both areas as result
Set SetDifference = Nothing
'alternatively
'set SetDifference = Nothing
 Exit Function
 End If

 On Error GoTo 0
 Dim aCell As Range
 For Each aCell In rngA
 Dim Result As Range
 If Application.Intersect(aCell, rngB) Is 
Nothing Then
     If Result Is Nothing Then
        Set Result = aCell
     Else
        Set Result = Union(Result, aCell)
    End If
   End If
   Next aCell
 Set SetDifference = Result

   End Function`

I'm not sure which method is actually the correct one to use for this type of referencing.

Any assistance would be most appreciated!!

Answer 1

Something like this should work:

Dim cA As Range, cB As Range, ws As Worksheet, rng As Range

Set ws = ActiveSheet 'or some specific sheet
With ws
    Set cA = .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
    Set cB = .Cells(.Rows.Count, "B").End(xlUp).Offset(0, -1)
    Set rng = .Range(cA, cB)
End With

rng.Value = "dateHere"