VB Help

S

Stan

I'm new to coding so any help you could provide would be greatly appreciated.

I'm wanting to find rows in a spreadsheet that contains the words "Use Start".

If found, I need to find rows above the found text that include the text
"Mgr." and "Agent" and below the text that includes "Mon1",
"Tue1",....."Sat1".

Then loop the code to continue to find all the rows that include "Use Start"
and the rows above and below that have Mgr., Agent, Mon1, Tue1,....Sat1.

All other rows in the spreadsheet would be deleted.

Here is some code that I started on to find rows that include "Use Start"
but it doesn't work.

Sub cleanup2()
Dim rng As Range
Set rng = Range("A:A").Find(What:="Use Start", After:=ActiveCell,
LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)

If rng Is Nothing Then
Do
Row.Delete

Loop While rng Is Nothing
End If

End Sub
 
J

joel

It is not clear exactly what you want. It sound like you have a group of
tables on one worksheet that has blank rows between each table. In each
table there is a row that contains "Use Start". You only want to keep
certain rows in the table above and below "Use Start"

When you delete rows the easiest way is to start at the end of the worksheet
and go up the worksheet to row 1. This way when you delete a row you can
still decrement by one to get to the next row. When you move in the other
direction you need to add one row when you don't delete and don't add one row
when you do delete.


Sub DeleteRows()

Keep1 = Array("Mgr", "Agent")

Keep2 = Array("Mon1", "Tue1", "Wed1", "Thur1", "Fri1", "Sat1")


LastRow = Range("A" & Rows.Count).End(xlUp).Row
RowCount = LastRow
AboveUseStart = True
Do While RowCount >= 1
Select Case Range("A" & RowCount)
Case "": AboveUseStart = True

Case "Use Start": AboveUseStart = False

Case Else
If AboveUseStart = True Then
SearchStr = Keep2
Else
SearchStr = Keep1
End If
Found = False
For Each itm In SearchStr
If Range("A" & RowCount) = itm Then
Found = True
Exit For
End If
Next itm
If Found = False Then
Rows(RowCount).Delete
End If

End Select
RowCount = RowCount - 1
Loop


End Sub
 
S

Stan

Here is some sample data. Yes, you are correct that I do want to keep the
data above and below the found text of "Use Start" for each instance where
"Use Start" is found.

MU: 790 CS NE LRO CSECSTele IEX TotalView
Page: 1
Agent Preferences Report

Thursday, 04/02/09



Sorting by: Id
All Mgr Values

Include: Default preferences
All date range preferences
Mgr: Barnett, Kymberlyn


Agent: 1405 Jordan, Hiawatha
Seniority: 03/16/01 - 3442 Rank: 0008

DEFAULT PREFERENCES

Last Modified: 03/31/09 07:51:52

Preferred Number Days Work: 1st choice: 2nd: 3rd: 4th: 5th:
6th: 7th: 8th:
Minimum Days Off: 0 Maximum Days Off: 7 Minimum Consecutive Days Off: 0

Preferred Weekly Hour: List
Hours Hours Hours Hours Hours Hours Hours Hours Hours Hours Hours
Hours
1 2 3 4 5 6 7 8 9 10 11
12


Hours Hours Hours Hours Hours Hours Hours Hours Hours Hours Hours
Hours
13 14 15 16 17 18 19 20 21 22 23
24



Fairness Volunteer Levels:
Sun: Request Off
Mon: Request Off
Tue: Request Off
Wed: Request Off
Thu: Request Off
Fri: Request Off
Sat: Request Off

DATE RANGE PREFERENCES

No date range preferences exist.



____________________


MU: 7900 CS NE LRO CSECSTele IEX TotalView
Page: 2
Agent Preferences Report

Thursday, 04/02/09



Sorting by: Id
All Mgr Values

Include: Default preferences
All date range preferences
Mgr: Barnett, Kymberlyn


Agent: 2452 Lacy, Becky
Seniority: 09/16/98 - 2859 Rank: 0002

DEFAULT PREFERENCES

Last Modified: 03/27/09 13:43:09

Preferred Number Days Work: 1st choice: 2nd: 3rd: 4th: 5th:
6th: 7th: 8th:
Minimum Days Off: 0 Maximum Days Off: 7 Minimum Consecutive Days Off: 0

Preferred Weekly Hour: List
Hours Hours Hours Hours Hours Hours Hours Hours Hours Hours Hours
Hours
1 2 3 4 5 6 7 8 9 10 11
12


Hours Hours Hours Hours Hours Hours Hours Hours Hours Hours Hours
Hours
13 14 15 16 17 18 19 20 21 22 23
24



Use Start Times for All Days of the Week: No

Start Start Start Start Start Start Start Start Start Start
Start Start Start Last
Day Pref Range 1 2 3 4 5 6 7 8 9
10 11 12 Modified

Mon1 Early-Late
03/27/09 16:05:14
Tue1 Early-Late
03/27/09 16:05:14
Thu1 Early-Late
03/27/09 16:05:14
Fri1 Early-Late
03/27/09 16:05:14

Fairness Volunteer Levels:
 
J

joel

I've done this type of programming 1000's of time before. Can yo answer some
additional questions

1) Is the data from a text file? It is easier to read a text file with some
filtering and put the data into the worksheet using a macro. You will have
less problems because the excel importing does some thing you may not want
like but data into two dffiernet rows when they were one row in the source
file
2) Post how you want the results to look. Any spacese beteen tables
(actually pages from your report). The columns where you want the data.
3) The code I'm think of writing will look at each row of the text file.
Only move rows into a workbook if the rows start with the data you need.
4) The results you posted has the lines starting with Mon1, Tue1, ... with
the data on the next line. Is this the way it is in the souce file? Do yo
want the results on 1 row of the worksheet?

5) Do you want any header rows or columns?
 
S

Stan

Joel, many many thanks for all your help!!

Here are the answers to your questions.

1) Yes, it is a text file that comes over in one column. I don't do any
text to column formatting.

2) Yes a space between each instance of the found text (Use Start, Agent,
Mgr, Mon1, Tue1,...Sat1) would be great!

3) Yes, that would be fine

4) I think its just wrapping due to space limitations. The actual data has
Mon1 and their corresponding data on the same row.

5) Headers are not required.
 
J

joel

The code will prompt for a txt file. You can change the two TXT in the
GEtOpenFileName to any extension. If this doesn't work you may have to send
me the text file. I can easily make changes if you don't like the format.

Sub ImportData()

Const ForReading = 1, ForWriting = -2, _
ForAppending = 3

ReadFile = Application _
.GetOpenFilename(FileFilter:="Text Files (*.txt), *.txt", _
Title:="Select Read File")
If ReadFile = False Then
MsgBox ("No file Selected - Exiting Macro")
End If

Cells.ClearContents

'Create two header rows
Range("A1") = "Agent"
Range("A2") = "Number"
Range("B2") = "Last Name"
Range("C2") = "First Name"

Range("D1") = "Manager"
Range("D2") = "Last Name"
Range("E2") = "First Name"

Range("F1") = "Mon1"
Range("F2") = "Preference"
Range("G2") = "Last Modified"

Range("H1") = "Tue1"
Range("H2") = "Preference"
Range("I2") = "Last Modified"

Range("J1") = "Wed1"
Range("J2") = "Preference"
Range("K2") = "Last Modified"

Range("L1") = "Thu1"
Range("L2") = "Preference"
Range("M2") = "Last Modified"

Range("N1") = "Fri1"
Range("N2") = "Preference"
Range("O2") = "Last Modified"

Range("P1") = "Sat1"
Range("P2") = "Preference"
Range("Q2") = "Last Modified"


Set fs = CreateObject("Scripting.FileSystemObject")
Set fin = fs.OpenTextFile(ReadFile, _
ForReading, TristateFalse)

RowCount = 2
Do While fin.AtEndOfStream <> True
ReadData = Trim(fin.readline)
'test if colon in line
ColonPos = InStr(ReadData, ":")
SpacePos = InStr(ReadData, " ")
'make sure there is a colon and it occurs before a spece
'otherwise there is a time with a colon in the line
If ColonPos > 0 And _
ColonPos < SpacePos Then
'get string in front of colon
Title = Trim(Left(ReadData, ColonPos - 1))
Select Case Title
Case "Mgr"
RowCount = RowCount + 1
Manager = Trim(Mid(ReadData, ColonPos + 1))
Mgr = Split(Manager, ",")
Range("D" & RowCount) = Trim(Mgr(0))
Range("E" & RowCount) = Trim(Mgr(1))
Case "Agent"
Agent = Trim(Mid(ReadData, ColonPos + 1))
Num = Trim(Left(Agent, InStr(Agent, " ") - 1))
Range("A" & RowCount) = Num
Agent = Trim(Mid(Agent, InStr(Agent, " ") + 1))
Agnt = Split(Agent, ",")
Range("B" & RowCount) = Trim(Agnt(0))
Range("C" & RowCount) = Trim(Agnt(1))
End Select
Else
If ReadData <> "" Then
'get first word of line
SpacePos = InStr(ReadData, " ")
If SpacePos > 0 Then
Word = Left(ReadData, SpacePos - 1)
Word = Trim(Word)
Select Case Word
Case "Mon1", "Tue1", "Wed1", "Thu1", _
"Fri1", "Sat1"

'redmove day of week from string
ReadData = Mid(ReadData, SpacePos + 1)
'remove spaces from beginning and end
ReadData = Trim(ReadData)

'split preference from last modified
SpacePos = InStr(ReadData, " ")
Preference = Left(ReadData, SpacePos - 1)
LastMod = Mid(ReadData, SpacePos + 1)
'remove spaces from beginning of string
LastMod = Trim(LastMod)

'get column number to put data
Set c = Rows(1).Find(what:=Word, _
LookIn:=xlValues, lookat:=xlWhole)
Cells(RowCount, c.Column) = Preference
Cells(RowCount, c.Column + 1) = LastMod

End Select
End If
End If
End If


Loop

Cells.Columns.AutoFit
fin.Close

End Sub
 
J

joel

I expect some of the file to be working. The code is very dependant on the
data and the porting of the file you senet me some areas of the text caused
errors which required me to modify the macro. I expect that some data is
missing for some agents or there is additional data for some adjents that
wasn't in the data you sent me.

joel dot warburg at itt dot com
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

VB Question 1
Coding Help 1
Placing the MsgBox "No ID found" statement in my code?? 12
VB Question 3
Code does not error but no copy either 4
Word macro that can call cells out of Excel for a find and replace 0
vb code question 2
Using While Wend with Cells.Find 1

Top