VBA Copy Range Until Cell Value = specific text/value

Question

I am trying to write a macro to copy data from a set of cells and paste it in a new worksheet.

I want to stop the selection where the last cell in column A that equals "HOURS TOTAL", which will be dynamic based on the data between A9 and the last row/cell where "HOURS TOTAL" is. I've tried four different methods and none of them produce the correct results.

Sub Copy_Data()
'
'Copy_Data Macro
'

'

Dim lastCell As String



Sheets("OPSEQB").Select
Range("A9", Range("P9").End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets.Add After:=ActiveSheet
Range("A1").Select
ActiveSheet.Paste


End Sub



Sub Copy_Data2()

Dim copyRange As String

Startrow = A9
LastRow = 11
Let copyRange = "A" & Startrow & ":" & "D" & LastRow
Range(copyRange).Select
End Sub




Sub Copy_Data3()
'
'Copy_Data Macro
'

'

Dim LastRow As String
LastRow = Range.SpecialCells(xlCellTypeLastCell, "HOURS TOTAL").Row


Sheets("OPSEQB").Select
Range("A9", Range("P9").End(xlToRight)).Select
Range(Selection, Selection.End(LastRow)).Select
Selection.Copy
Sheets.Add After:=ActiveSheet
Range("A1").Select
ActiveSheet.Paste


End Sub



Sub Copy_Data4()
'Best used when you want to include all data stored on the spreadsheet

Dim sht As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range

Set sht = Worksheets("OPSEQB")
Set StartCell = Range("A9")

'Refresh UsedRange
  Worksheets("OPSEQB").UsedRange

'Find Last Row and Column
  LastRow = StartCell.SpecialCells(xlCellTypeLastCell, "HOURS TOTAL").Row
  LastColumn = StartCell.SpecialCells(xlCellTypeLastCell).Column

'Select and copy Range
  sht.Range(StartCell, sht.Cells(LastRow, LastColumn)).Select
  Selection.Copy
'Add a sheet and paste the range
  Sheets.Add After:=ActiveSheet
  Range("A1").Select
  ActiveSheet.Paste


End Sub

score 1 · Answer 1 · answered Oct 05 '20 at 21:11

1

I would search the first column for "HOURS TOTAL" using Application.WorksheetFunction.Match(), select all the cells from A9 down to the matching row and then select to the right.

Public Sub Copy_Data()

    Dim lastCell As Range, wrkSht As Worksheet
    Dim lastRow As Integer, firstCol As Range
    Dim copyRng As Range
    
    Set wrkSht = ActiveWorkbook.Worksheets("OPSEQB")
    lastRow = Application.WorksheetFunction.Match("HOURS TOTAL", wrkSht.Range("A:A"))
    Set firstCol = wrkSht.Range(wrkSht.Range("A9"), wrkSht.Cells(lastRow, 1))
    Set copyRng = wrkSht.Range(firstCol, firstCol.End(xlToRight))

    copyRng.Copy
    Sheets.Add After:=ActiveSheet
    Range("A1").Select
    ActiveSheet.Paste

End Sub

answered Oct 05 '20 at 21:11

BoilermakerRV

299
1
8

Even though I like my answer more, I'll give you an upvote as it's not a bad first answer. A couple of friendly tips: 1. Don't use select (https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) 2. No need to copy ALL columns. Better to scope to usedrange as OP was trying to do. – pgSystemTester Oct 05 '20 at 21:37
@PGSystemTester - Thanks. 1) I normally don't use select either, but I was torn between doing it "my way" and somewhat preserving the OP's code. 2) I don't think I selected all columns (i.e. "A:XFD"). Range.End() only extends to the last cell that contains data. I did not know about UsedRange though. That could come in handy. – BoilermakerRV Oct 05 '20 at 22:51
1

OH sorry... forgot to vote! And `.usedRange` is a must-know as you carry forward in your VBA Excel Adventures.... good luck! – pgSystemTester Oct 05 '20 at 22:56

pgSystemTester · Answer 2 · 2020-10-05T21:30:49.993

There's a lot of ways to do this. I think if you make finding the range its own function, the code becomes more clear (to me). This should work and it's available to test in this file here.

Sub Copy_Data()

Sheets.Add After:=ActiveSheet
findStuff.Copy Range("A1")

End Sub


Private Function findStuff() As Range
    Const starCellAddress As String = "A9"
    Const targetText As String = "HOURS TOTAL"
    Const sName As String = "OPSEQB"

    Dim WS As Worksheet
        Set WS = Sheets(sName)
    
    For Each acell In Intersect(WS.Range(starCellAddress).EntireColumn, WS.UsedRange).Cells
        If UCase(acell.Value) = UCase(targetText) Then
            Exit For
        End If
    Next acell
    
    
    'if you want all columns in this range
        Set findStuff = Intersect(Range(WS.Range(starCellAddress), acell).EntireRow, WS.UsedRange)
    
    'if you just want column A
       ' Set findStuff = Range(ws.Range(starCellAddress), acell)

End Function

VBA Copy Range Until Cell Value = specific text/value

2 Answers2