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

[Skrej]

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

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

<tbody>
</tbody>

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

VM	1234	Smith	John	8:30	Jones
VM	4567	Rogers	Grant	8:30	Jones
VM	3333	Grey	Luke	8:30	Pers
VM	6666	Mann	Mark	8:30	Pers

<tbody>
</tbody>

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.

 

[hiker95]

Skrej,

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

Excel 2007
	A	B	C	D	E	F	G	H	I
1		Testing Program : DKSFS
2		Scoring Center : Concord
3
4
5		Rater Schedule Date : 07/29/2013
6
7		Scoring Leader : 3456 : Jones	Mark
8		Emp. ID	Last name	First Name	Start time	Hours Sched	Shift code	work location	Position code
9	VM	1234	Smith	John	8:30	8.5	1	home	RD
10		2345	Doe	Jane	8:30	8.5	1	home	RD
11		3456	Jones	Mark	8:30	8.5	1	home	SL
12	VM	4567	Rogers	Grant	8:30	8.5	1	home	RD
13		Scoring Leader Total : (Jones	Mark):4
14		Scoring Center Total : 4
15
16		Testing Program : DKSFS
17		Scoring Center : Concord
18		Rater Schedule Date : 07/29/2013
19
20		Scoring Leader : 3456 : Pers	Matt
21
22		2222	Smitts	Jon	8:30	8.5	1	home	RD
23	VM	3333	Grey	Luke	8:30	8.5	1	home	RD
24		4444	Pers	Matt	8:30	8.5	1	home	SL
25	VM	5555	Mann	Mark	8:30	8.5	1	home	RD
26		6666	Smith	Sue	8:30	8.5	1	home	RD
27
28		Scoring Leader Total : (Pers	Matt):5
29		Scoring Center Total : 5
30
Sheet1

After the macro:

Excel 2007
	J	K	L	M	N	O	P	Q
1		VM	1234	Smith	John	8:30	Jones
2		VM	4567	Rogers	Grant	8:30	Jones
3		VM	3333	Grey	Luke	8:30	Pers
4		VM	5555	Mann	Mark	8:30	Pers
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).

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.

 

[Skrej]

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.

 

[hiker95]

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

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.

 

[Skrej]

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.

 

[hiker95]

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?

 

[Skrej]

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?

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.

 

[hiker95]

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).

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.

 

[Skrej]

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.....

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

 

[hiker95]

Skrej,

You are very welcome. Glad I could help.

Thanks for the feedback.

And, come back anytime.