How to search a changing range in a given column (VBA code)

Skrej

Skrej

Board Regular
Joined
May 31, 2013
Messages
176
Office Version
  1. 365
Platform
  1. Windows
Hi all

I'd like to create a macro that searches a column within a changing, variable range.

For example, I have a roster with a list of teams. Each team is separated by a blank row. In each team, there are a varying number of team members, and one team leader. Column I has the position code, which designates whether the person is the team leader (SL), or just a team member (RD).

What I'd like to do, is search each team for the team leader, then check another column (Col A) just within that team for another value, and if that value is present return the last name of the team leader as well as the name of the member with the value in Col A.

The problem is, I'm not sure how to search a varying range in Col I. Teams can vary in size from 3-11 members (including leader), and the number of teams varies each day. I don't have the option of changing the format or layout of the roster - it's automatically generated by some other program and given to me in a CSV list.

For example, from this sample data of two teams

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD][TABLE="width: 64"]
<colgroup><col width="64"></colgroup><tbody>[TR]
[TD="width: 64"]Testing Program : DKSFS
[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][TABLE="width: 64"]
<colgroup><col width="64"></colgroup><tbody>[TR]
[TD="width: 64"]Scoring Center : Concord
[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][TABLE="width: 64"]
<colgroup><col width="64"></colgroup><tbody>[TR]
[TD="width: 64"][/TD]
[/TR]
[TR]
[TD="width: 64"][/TD]
[/TR]
[TR]
[TD="width: 64"]Rater Schedule Date : 07/29/2013
[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Scoring Leader : 3456 : Jones
[/TD]
[TD]Mark
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Emp. ID
[/TD]
[TD]Last name
[/TD]
[TD]First Name
[/TD]
[TD]Start time
[/TD]
[TD]Hours Sched
[/TD]
[TD]Shift code
[/TD]
[TD]work location
[/TD]
[TD]Position code
[/TD]
[/TR]
[TR]
[TD]VM
[/TD]
[TD]1234
[/TD]
[TD]Smith
[/TD]
[TD]John
[/TD]
[TD]8:30
[/TD]
[TD]8.5
[/TD]
[TD]1
[/TD]
[TD]home
[/TD]
[TD]RD
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]2345
[/TD]
[TD]Doe
[/TD]
[TD]Jane
[/TD]
[TD]8:30
[/TD]
[TD]8.5
[/TD]
[TD]1
[/TD]
[TD]home
[/TD]
[TD]RD
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]3456
[/TD]
[TD]Jones
[/TD]
[TD]Mark
[/TD]
[TD]8:30
[/TD]
[TD]8.5
[/TD]
[TD]1
[/TD]
[TD]home
[/TD]
[TD]SL
[/TD]
[/TR]
[TR]
[TD]VM
[/TD]
[TD]4567
[/TD]
[TD]Rogers
[/TD]
[TD]Grant
[/TD]
[TD]8:30
[/TD]
[TD]8.5
[/TD]
[TD]1
[/TD]
[TD]home
[/TD]
[TD]RD
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Scoring Leader Total : (Jones
[/TD]
[TD]Mark):4
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Scoring Center Total : 4
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Testing Program : DKSFS
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Scoring Center : Concord
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Rater Schedule Date : 07/29/2013
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Scoring Leader : 3456 : Pers
[/TD]
[TD]Matt
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]2222
[/TD]
[TD]Smitts
[/TD]
[TD]Jon
[/TD]
[TD]8:30
[/TD]
[TD]8.5
[/TD]
[TD]1
[/TD]
[TD]home
[/TD]
[TD]RD
[/TD]
[/TR]
[TR]
[TD]VM
[/TD]
[TD]3333
[/TD]
[TD]Grey
[/TD]
[TD]Luke
[/TD]
[TD]8:30
[/TD]
[TD]8.5
[/TD]
[TD]1
[/TD]
[TD]home
[/TD]
[TD]RD
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]4444
[/TD]
[TD]Pers
[/TD]
[TD]Matt
[/TD]
[TD]8:30
[/TD]
[TD]8.5
[/TD]
[TD]1
[/TD]
[TD]home
[/TD]
[TD]SL[/TD]
[/TR]
[TR]
[TD]VM
[/TD]
[TD]5555
[/TD]
[TD]Mann
[/TD]
[TD]Mark
[/TD]
[TD]8:30
[/TD]
[TD]8.5
[/TD]
[TD]1
[/TD]
[TD]home
[/TD]
[TD]RD
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]6666
[/TD]
[TD]Smith
[/TD]
[TD]Sue
[/TD]
[TD]8:30
[/TD]
[TD]8.5
[/TD]
[TD]1
[/TD]
[TD]home
[/TD]
[TD]RD
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Scoring Leader Total : (Pers
[/TD]
[TD]Matt):5
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Scoring Center Total : 5
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

I'd like to return a list that starts at say K1 (arbitrary) that would give me this:

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]VM
[/TD]
[TD]1234
[/TD]
[TD]Smith
[/TD]
[TD]John
[/TD]
[TD]8:30
[/TD]
[TD]Jones
[/TD]
[/TR]
[TR]
[TD]VM
[/TD]
[TD]4567
[/TD]
[TD]Rogers
[/TD]
[TD]Grant
[/TD]
[TD]8:30
[/TD]
[TD]Jones
[/TD]
[/TR]
[TR]
[TD]VM
[/TD]
[TD]3333
[/TD]
[TD]Grey
[/TD]
[TD]Luke
[/TD]
[TD]8:30
[/TD]
[TD]Pers
[/TD]
[/TR]
[TR]
[TD]VM
[/TD]
[TD]6666
[/TD]
[TD]Mann
[/TD]
[TD]Mark
[/TD]
[TD]8:30
[/TD]
[TD]Pers
[/TD]
[/TR]
</tbody>[/TABLE]

What I'm stumped on is how to define that range in Col I which changes with each new team. My approach is to find a way to search a range (essentially the values between blank cells ) in Col I for the value "SL", then search that same range in Col A for the value "VM". If there's a value of VM within that range (team), then copy Cols A-E, write them to a list, and insert that person's team leader last name at the right.

Any suggestions for how to define a dynamic range in Col I? Or maybe suggestions on how to approach the problem in a different manner? I already have a working macro written which generates that last time, sans team leader name, just trying to figure out how to search that changing range in Col I for each team to find team leader name.

Note, not all teams will have a member flagged with that VM marker in Col A.

Thanks for suggestions.
 

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
Sort by date Sort by votes
Skrej,

Sample raw data (not all columns are shown for brevity):


Excel 2007
ABCDEFGHI
1Testing Program : DKSFS
2Scoring Center : Concord
3
4
5Rater Schedule Date : 07/29/2013
6
7Scoring Leader : 3456 : JonesMark
8Emp. IDLast nameFirst NameStart timeHours SchedShift codework locationPosition code
9VM1234SmithJohn8:308.51homeRD
102345DoeJane8:308.51homeRD
113456JonesMark8:308.51homeSL
12VM4567RogersGrant8:308.51homeRD
13Scoring Leader Total : (JonesMark):4
14Scoring Center Total : 4
15
16Testing Program : DKSFS
17Scoring Center : Concord
18Rater Schedule Date : 07/29/2013
19
20Scoring Leader : 3456 : PersMatt
21
222222SmittsJon8:308.51homeRD
23VM3333GreyLuke8:308.51homeRD
244444PersMatt8:308.51homeSL
25VM5555MannMark8:308.51homeRD
266666SmithSue8:308.51homeRD
27
28Scoring Leader Total : (PersMatt):5
29Scoring Center Total : 5
30
Sheet1


After the macro:


Excel 2007
JKLMNOPQ
1VM1234SmithJohn8:30Jones
2VM4567RogersGrant8:30Jones
3VM3333GreyLuke8:30Pers
4VM5555MannMark8:30Pers
5
Sheet1


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Code: 
Option Explicit
Sub FindSL_VMs()
' hiker95, 08/01/2013
' http://www.mrexcel.com/forum/excel-questions/717636-how-search-changing-range-given-column-visual-basic-applications-code.html
Dim Area As Range, r As Long, sr As Long, er As Long, n As Long, nr As Long
Dim c As Range, rng1 As Range, rng2 As Range, tl As String
Application.ScreenUpdating = False
Columns("K:P").ClearContents
nr = 0
For Each Area In Range("I1", Range("I" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants).Areas
  With Area
    n = Application.CountIf(Area, "SL")
    If n > 0 Then
      sr = .Row
      er = sr + .Rows.Count - 1
      Set rng1 = Range("I" & sr + 1 & ":I" & er)
      For Each c In rng1
        If c = "SL" Then
          tl = c.Offset(, -6).Value
          Exit For
        End If
      Next c
      Set rng2 = Range("A" & sr + 1 & ":A" & er)
      For Each c In rng2
        If c = "VM" Then
          nr = nr + 1
          Range("K" & nr).Resize(, 5).Value = c.Resize(, 5).Value
          Range("P" & nr) = tl
        End If
      Next c
    End If
  End With
Next Area
Range("O1:O" & nr).NumberFormat = "h:mm"
Columns("K:P").AutoFit
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the FindSL_VMs macro.
 
Upvote 0
Wow, thank you very much hiker. I was actually just asking for some suggestions on how to search, not the entire macro, but thank you extra much for that. I think I see how you used the blank rows to define ranges.

I did get your code to work on the same sample data as I posted. However, when I try and run it on a different set of data, I get no results. Not sure why, I'll have to try and troubleshoot. I'm on the road and may not have a chance to pick at it for a few days, but I think I'll be able to pick it apart and find the issue when I get a chance to look at in more in depth.

Did want to publicly acknowledge your work and say thank you, though. Much obliged.
 
Upvote 0
Skrej,

You are very welcome. Glad I could help.

I did get your code to work on the same sample data as I posted. However, when I try and run it on a different set of data, I get no results. Not sure why
Click to expand...

So that we can get it right this next time:

Can you post a screenshot of the raw data worksheet (to include column and row references), and, post a screenshot of the worksheet results (manually formatted by you) that you are looking for?

To post your data, you can download and install one of the following two programs:
Excel Jeanie
MrExcel HTML Maker


If you are not able to give us screenshots:
You can upload your workbook to Box Net,
sensitive data changed
mark the workbook for sharing
and provide us with a link to your workbook.
 
Upvote 0
Hi,

I've looked at it a little bit, and haven't been able to troubleshoot it yet, so here's a link to the Box file. https://app.box.com/s/ic2u6h7g6nugk0y326bm

There are two sheets - Sheet1 with my original sample data, which works with your macro, and Sheet2 with an exact copy of today's data output with some redactions. I'm overlooking the differences in layouts and references, somehow.

I did move the output over to start in Col R, but as you can see on Sheet1, it still works as intended.

Both sheets also have a button to trigger the macro.

Thanks again.
 
Upvote 0
Skrej,

In your latest workbook, Sheet2, we are looking in column A for a string like this VM CM?

What is the starting column for the results?
 
Last edited:
Upvote 0
hiker95 said:
Skrej,

In your latest workbook, Sheet2, we are looking in column A for a string like this VM CM?

What is the starting column for the results?
Click to expand...

Yes, I'm looking for a string VM CM (previously we looked for VM) in Col A. The results will have to start in Col R now.
 
Upvote 0
Skrej,

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Code: 
Option Explicit
Sub FindSL_VMCMs()
' hiker95, 08/04/2013
' http://www.mrexcel.com/forum/excel-questions/717636-how-search-changing-range-given-column-visual-basic-applications-code.html
Dim Area As Range, r As Long, sr As Long, er As Long, n As Long, nr As Long
Dim c As Range, rng1 As Range, rng2 As Range, tl As String
n = Application.CountIf(Columns(1), "VM CM")
If n = 0 Then
  MsgBox "There are no entries in column A = 'VM CM' - macro terminated!!!"
  Exit Sub
End If
Application.ScreenUpdating = False
Columns("R:W").ClearContents
nr = 0
For Each Area In Range("I1", Range("I" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants).Areas
  With Area
    n = Application.CountIf(Area, "*SL*")
    If n > 0 Then
      sr = .Row
      er = sr + .Rows.Count - 1
      Set rng1 = Range("I" & sr + 1 & ":I" & er)
      For Each c In rng1
        If InStr(Trim(c), "SL") > 0 Then
          tl = c.Offset(, -6).Value
          Exit For
        End If
      Next c
      Set rng2 = Range("A" & sr + 1 & ":A" & er)
      For Each c In rng2
        If InStr(Trim(c), "VM CM") > 0 Then
          nr = nr + 1
          Range("R" & nr).Resize(, 5).Value = c.Resize(, 5).Value
          Range("W" & nr) = tl
        End If
      Next c
    End If
  End With
Next Area
Range("V1:V" & nr).NumberFormat = "h:mm"
Columns("R:W").AutoFit
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the FindSL_VMCMs macro.
 
Upvote 0
Solution
Hiker,

Thank you once again. Everything's working perfectly. Not quite sure I follow all your changes just yet, but the important thing is it's up and working. Verified that swapping in new rosters doesn't cause any gremlins - worked flawlessly over 4 different roster swaps.

I actually made a couple of additions - one to include SL's email, then basically copied everything again to do a new search for results based on "OP CM"( a separate list we have).

I tried including your macro into mine (which generates the VM/OP CM marker in Col A by comparing people working that day to a master list, but that resulted in your macro giving the "There are NO VM CM's today" popup.

I solved that by simply calling your macro to run inside mine, and for some reason, that does the trick.

Just for the heck of it, I'll include the final product code. I then copied everything making appropriate changes to search for"OP CM". I haven't decided if I'll have them print output to separate spots (played a bit with that option, but since we don't always use both lists on a given day, I reverted back to just overwriting all output lists in cell R1).

Thank you again - this will save me (and others) about 20-30 minutes of work each day - we were previously cross referencing the lists of VM/OP CM manually against a given day's roster, by searching and finding, which was quite labor intensive. Now it's down to about 3 minutes to pull up the current day's roster, copy and paste in it, then run the macro.

Beer's on me, sorry it's e-beer and not true brew.....:beerchug:

Code: 
Sub FindVmCM()


Application.ScreenUpdating = False


Dim rnge1, rnge2, cell1, cell2 As Range

Set rnge1 = Sheets("VM CM List").Range("A6:A100")
Set rnge2 = Sheets("Today's Rosters").Range("B1:B400")

For Each cell1 In rnge1
If IsEmpty(cell1.Value) Then cell1.Value = ""
For Each cell2 In rnge2
If cell1.Value = cell2.Value And cell1.Value <> "" Then

cell2.Font.Bold = True
cell2.Interior.ColorIndex = 3
cell2.Interior.Pattern = xlSolid
cell2.Offset(0, -1).Value = "VM CM"

End If
Next cell2
Next cell1

Call FindSL_VMCMs
End Sub
'Option Explicit

Sub FindSL_VMCMs()
' hiker95, 08/04/2013
' http://www.mrexcel.com/forum/excel-questions/717636-how-search-changing-range-given-column-visual-basic-applications-code.html
Sheets("Today's Rosters").Activate
Dim Area As Range, r As Long, sr As Long, er As Long, n As Long, nr As Long
Dim c As Range, rng1 As Range, rng2 As Range, tl As String, eml As String
n = Application.CountIf(Columns(1), "VM CM")
If n = 0 Then
  MsgBox "There are no VM CM raters scheduled today - huzzah!!"
  Exit Sub
End If
Application.ScreenUpdating = False
Columns("R:y").ClearContents
nr = 1
With Range("R1:y1").Font
.Bold = True
End With
Range("s1").Value = "CM Type"
Range("t1").Value = "Rater ID"
Range("u1").Value = "Last Name"
Range("v1").Value = "First Name"
Range("w1").Value = "Shift Start"
Range("x1").Value = "SL"
Range("y1").Value = "SL Email"
For Each Area In Range("I1", Range("I" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants).Areas
  With Area
    n = Application.CountIf(Area, "*SL*")
    If n > 0 Then
      sr = .Row
      er = sr + .Rows.Count - 1
      Set rng1 = Range("I" & sr + 1 & ":I" & er)
      For Each c In rng1
        If InStr(Trim(c), "SL") > 0 Then
          tl = c.Offset(, -6).Value
          eml = c.Offset(, 2).Value
          Exit For
        End If
      Next c
      Set rng2 = Range("A" & sr + 1 & ":A" & er)
      For Each c In rng2
        If InStr(Trim(c), "VM CM") > 0 Then
          nr = nr + 1
          Range("S" & nr).Resize(, 5).Value = c.Resize(, 5).Value
          Range("X" & nr) = tl
          Range("Y" & nr) = eml
        End If
      Next c
    End If
  End With
Next Area
Range("W2:W" & nr).NumberFormat = "h:mm"
Columns("R:Y").AutoFit
Application.ScreenUpdating = True
Range("R1").Activate

End Sub
 
Upvote 0
Skrej,

You are very welcome. Glad I could help.

Thanks for the feedback.

And, come back anytime.
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question Question
VBA - Prioritize, Generate and Fill Numbers with multiple criterias
Replies
0
Views
785
cmccall95
C
S
  • Question Question
How to get VBA search to return the row of data if the last cell in the range has no data in it
Replies
1
Views
880
Saurabhj
Saurabhj
A
  • Question Question
Date Range based on Cell Value
Replies
3
Views
672
Fluff
Fluff
T
  • Question Question
VBA to launch userform by selecting a cell
2
Replies
10
Views
2K
Logit
Logit
D
  • Question Question
Additional help needed - VBA coding
Replies
1
Views
677
Marcelo Branco
M

Forum statistics

Threads
1,223,240
Messages
6,170,951
Members
452,368
Latest member
jayp2104

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top