Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Find range of cells, when given 2 Dates

Tags:

excel

vba

I have a table with numbers from 1 to 10. (Starting from D2 to M2)

Suppose in A1 there is 03/09/2019

AND in B1 there is 06/09/2019

AND in C1 there is Hello

In COLUMN A I have a multiple series of words starting from A3 to A10

Here is an Example of the Excel Table

enter image description here

What I would like to do is: Search for the word Student in Column A, when I find it, get the numbers from A1 --> 3 and A2 --> 6 and write the word Hello that is in C1 in the cells that go to 3 to 6 in the row of the finded word Student

So my output would be like:

enter image description here

This is my code so far:

Dim Cell As Range
Columns("A:A").Select 
Set Cell = Selection.Find(What:="Student", After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)

If Cell Is Nothing Then
    MsgBox "Word not found"

Else
    MsgBox "Word found"
End If

Basically I can find the word Student but don't know how to write the word Hello in the cells between 3 to 6

like image 951
ChangeWorld Avatar asked Dec 06 '25 08:12

ChangeWorld


2 Answers

A few notes regarding the code below (not tested!).

1) Always try use worksheet qualifiers when working with VBA. This will allow for cleaner code with less room for unnecessary errors

2) When using .Find method I use LookAt:=xlWhole because if you do not explicitly define this your code will use the last known method that you would have used in Excel. Again, explicit definition leaves less room for error.

3) Try include error handling when you code. This provides “break points” for easier debugging in the future.

4) You can make the below much more dynamic that it currently is. But I'll leave that up to you to learn how to do!

Option Explicit

Sub SearchAndBuild()

    Dim rSearch As Range
    Dim lDayOne As Long, lDayTwo As Long
    Dim lColOne As Long, lColTwo As Long
    Dim sHello As String
    Dim wsS1 As Worksheet
    Dim i As Long


    'set the worksheet object
    Set wsS1 = ThisWorkbook.Sheets("Sheet1")
    'store variables
    lDayOne = Day(wsS1.Range("A1").Value)
    lDayTwo = Day(wsS1.Range("B1").Value)
    sHello = wsS1.Range("C1").Value

    'find the student first
    Set rSearch = wsS1.Range("A:A").Find(What:="Student", LookAt:=xlWhole)

    'error handling
    If rSearch Is Nothing Then
        MsgBox "Error, could not find Student."
        Exit Sub
    End If

    'now loop forwards to find first date and second date - store column naumbers
    'adjust these limits where necessary - can make dynamic
    For i = 4 To 13
        If wsS1.Cells(2, i).Value = lDayOne Then
            lColOne = i
        End If
        If wsS1.Cells(2, i).Value = lDayTwo Then
            lColTwo = i
            Exit For
        End If
    Next i

    'now merge the range
    wsS1.Range(wsS1.Cells(rSearch.Row, lColOne), wsS1.Cells(rSearch.Row, lColTwo)).Merge

    'set the vvalue
    wsS1.Cells(rSearch.Row, lColOne).Value = sHello

End Sub

This is just one way to approach the problem. Hopefully this helps your understanding!

like image 105
Dean Avatar answered Dec 09 '25 00:12

Dean


No need for a loop here - just find your value and parse the dates. Assuming your value to be found exists in Column A and your table starts in Column D, there is clear relationship between the columns which is Day(date) + 3.


Sub Test()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim lr As Long, Found As Range
Dim date_a As Long, date_b As Long

lr = ws.Range("A" & ws.Rows.Count).End(xlUp).Row

Set Found = ws.Range("A2:A" & lr).Find("Student", LookIn:=xlValues)

If Not Found Is Nothing Then
    date_a = Day(Range("A1")) + 3
    date_b = Day(Range("B1")) + 3

    With ws.Range(ws.Cells(Found.Row, date_a), ws.Cells(Found.Row, date_b))
        .Merge
        .Value = ws.Range("C1")
    End With

Else
    MsgBox "Value 'Student' Not Found"
End If

End Sub
like image 33
urdearboy Avatar answered Dec 08 '25 23:12

urdearboy



Donate For Us

If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!