0
votes

Need macro to perform the following tasks -
1. Identify the column number of a specific string in a range
2. Find the location of the first value in the identified column.
3. Copy the range starting from the first value till the first blank row.
4. Paste the values in a specified location on a different sheet.

enter image description here

In the above example, lets say the task is to find the column number of the text "B". Once identified, find the first value that starts in that column (in this case, it is 25, cell B4) and then, copies the range before it encounters the first blank, i.e. B4:B8 to a different worksheet.

Thank you!

1
you're most Welcome!Abhinav Rawat

1 Answers

0
votes

Following might be helpful.

Sub Demo()
    Dim srcSht As Worksheet, destSht As Worksheet
    Dim rng As Range, fCell As Range, lCell As Range, copyRng As Range
    Dim lastRow As Long, i As Long, rowNum As Long
    Dim colAStr As String, colBStr As String, colCStr As String, searchStr As String

    Set srcSht = ThisWorkbook.Sheets("Sheet1")  'change Sheet1 to your data sheet
    Set destSht = ThisWorkbook.Sheets("Sheet2")  'change Sheet2 to your output sheet
    rowNum = 2          'change "2" to row number of header
    searchStr = "b"     'change "b" to search string

    With srcSht
        Set rng = .Rows(rowNum).Find(searchStr, LookIn:=xlValues) 'find "b" in row 2
        If Not rng Is Nothing Then
            If IsEmpty(.Cells(2, rng.Column).Offset(1, 0)) Then 'get cell address with value below header
                Set fCell = .Cells(rowNum, rng.Column).End(xlDown)
            Else
                Set fCell = .Cells(2, rng.Column).Offset(1, 0)
            End If
            If IsEmpty(fCell.Offset(1, 0)) Then 'get cell address before first blank
                Set lCell = fCell
            Else
                Set lCell = fCell.End(xlDown)
            End If
            Set copyRng = .Range(fCell, lCell)
            copyRng.Copy destSht.Range("N1")    'copy range to "Cell N1" in destSht
        Else
            MsgBox "String not found"    'if string not found in header row, display message
        End If
    End With
End Sub