Extract cells and determine Range

[eckert1961]

Hello,

I have an Excel 2007 workbook and what I want to do is to have code that will loop through the cells in Column B, most of which are blank. When it finds a cell with text in it I want the contents to be extracted and copied to a new sheet. The next part of this would be to determine the range from the start of the search to the cell that contains the text and then do a sum of the Costs in column I.

For example: The search would begin at B7 and text would be found in B149. The range would be B7:B149. The code then would use this range but change it to I7:I149 and sum the costs in column I. Both the text and the sum would be entered in a new Sheet.

Test $12,000.00

Once entered I would need the code to continue on to the end of the data in Sheet1.

Any assistance would be greatly appreciated. Thank you.

Regards,
Chris

 

[John Davis]

Hello,

I have an Excel 2007 workbook and what I want to do is to have code that will loop through the cells in Column B, most of which are blank. When it finds a cell with text in it I want the contents to be extracted and copied to a new sheet. The next part of this would be to determine the range from the start of the search to the cell that contains the text and then do a sum of the Costs in column I.

For example: The search would begin at B7 and text would be found in B149. The range would be B7:B149. The code then would use this range but change it to I7:I149 and sum the costs in column I. Both the text and the sum would be entered in a new Sheet.

Test $12,000.00

Once entered I would need the code to continue on to the end of the data in Sheet1.

Any assistance would be greatly appreciated. Thank you.

Regards,
Chris

Not sure I completely understand, but this may help or at least give you some ideas

Sub eckert1961()
Dim i As Long
Dim lr As Long


Sheets.Add.Name = "New Sheet"

lr = Sheets("Sheet1").Cells(Rows.Count, 9).End(3).Row

For i = lr To 7 Step -1

    If Range("B" & i) <> "" Then
    
        Range(Range("A7"), Range("I" & i)).Copy Sheets("New Sheet").Range("A" & Rows.Count).End(3)(2)
        
        Sheets("New Sheet").Range("I" & Rows.Count).End(3).Offset(1).Formula = "=SUM(""I2:I"" & lr)"
        
        Sheets("New Sheet").Range("A" & Rows.Count).End(3).Offset(1).Value = "Total"
        
    End If
    
Next i
        


End Sub

 

[eckert1961]

Thanks John,

Your code definitely gives me a starting point. I'll test it out and see if I have any other questions.

Regards,
Chris

 

[John Davis]

Thanks John,

Your code definitely gives me a starting point. I'll test it out and see if I have any other questions.

Regards,
Chris

You're welcome, I hope it works out for you. Thanks for the feedback.

 

[eckert1961]

Hi John,

I think I need some explanation on the meaning of the code as I'm not sure what I need to change to work with my data. Here is a sample:

Excel Workbook
	A	B	C	D	E	F	G	H	I	J
139					Review Interface with client for Sign Off
140							Upside Software Solution Architect	1	$ 165.00	03/06/2011
141					Review Interface with client for Sign Off
142							Upside Software Senior Technical Analyst	1	$ 165.00	03/06/2011
143					Review Interface with client for Sign Off
144							Client	1	$ -	03/06/2011
145					Interface Specification Document - Clean up/Rework
146							Upside Software Solution Architect	8	$ 1,320.00	03/06/2011
147					Interface Specification Document - Clean up/Rework
148							Upside Software Senior Technical Analyst	8	$ 1,320.00	03/06/2011
149		MILESTONE: Completion of Business Process Review and Analysis
Client

Excel 2007

The starting point to find occurrances of Milestone* is B15. In the sample the 1st Milestone is in cell B149. What I want is for the text to be moved to a new sheet and then the sum of I15:I149 to be entered into the cell adjacent to the text in the new sheet.

MILESTONE: Completion of Business Process Review and Analysis $39,847.50

I then want the code to find the next occurrance which in my current sheet is found in B259 and so on until the end of data. Once all Milestones and sums are copied to the new sheet I want all to be totaled.

Thanks in advance for additional assistance.

Regards,
Chris

 

[eckert1961]

Hi John,

I altered your code slightly, as I'm not really sure what I'm doing and all that I accomplish is the creation of a new sheet. Here is what I changed.

Sub Milestones()
Dim i As Long
Dim lr As Long


Sheets.Add.Name = "Milestones"

lr = Sheets("Client").Cells(Rows.Count, 1000).End(3).Row

For i = lr To 7 Step -1

    If Range("B" & i) <> "" Then
    
        Range(Range("A7"), Range("I" & i)).Copy Sheets("Milestones").Range("A" & Rows.Count).End(3)(2)
        
        Sheets("Milestones").Range("I" & Rows.Count).End(3).Offset(1).Formula = "=SUM(""I2:I"" & lr)"
        
        Sheets("Milestones").Range("A" & Rows.Count).End(3).Offset(1).Value = "Milestones"
        
    End If
    
Next i
        


End Sub

Any assistance would be appreciated.

Regards,
Chris

 

[John Davis]

Hi John,

I altered your code slightly, as I'm not really sure what I'm doing and all that I accomplish is the creation of a new sheet. Here is what I changed.

Sub Milestones()
Dim i As Long
Dim lr As Long


Sheets.Add.Name = "Milestones"

lr = Sheets("Client").Cells(Rows.Count, 1000).End(3).Row

For i = lr To 7 Step -1

    If Range("B" & i) <> "" Then
    
        Range(Range("A7"), Range("I" & i)).Copy Sheets("Milestones").Range("A" & Rows.Count).End(3)(2)
        
        Sheets("Milestones").Range("I" & Rows.Count).End(3).Offset(1).Formula = "=SUM(""I2:I"" & lr)"
        
        Sheets("Milestones").Range("A" & Rows.Count).End(3).Offset(1).Value = "Milestones"
        
    End If
    
Next i
        


End Sub

Any assistance would be appreciated.

Regards,
Chris

Chris:

Sorry for the late response. See my PM response to yours.

 

[John Davis]

Hi John,

I altered your code slightly, as I'm not really sure what I'm doing and all that I accomplish is the creation of a new sheet. Here is what I changed.

Sub Milestones()
Dim i As Long
Dim lr As Long


Sheets.Add.Name = "Milestones"

lr = Sheets("Client").Cells(Rows.Count, 1000).End(3).Row

For i = lr To 7 Step -1

    If Range("B" & i) <> "" Then
    
        Range(Range("A7"), Range("I" & i)).Copy Sheets("Milestones").Range("A" & Rows.Count).End(3)(2)
        
        Sheets("Milestones").Range("I" & Rows.Count).End(3).Offset(1).Formula = "=SUM(""I2:I"" & lr)"
        
        Sheets("Milestones").Range("A" & Rows.Count).End(3).Offset(1).Value = "Milestones"
        
    End If
    
Next i
        


End Sub

Any assistance would be appreciated.

Regards,
Chris

Chris:

lr = Sheets("Client").Cells(Rows.Count, 1000).End(3).Row

With your change, I don't think there are 1000 Columns, but I'm using 2003. Not sure about, 2007 or 2010.

 

[eckert1961]

Hi John,

You're correct that there aren't 1000 columns in my workbook. I entered 1000 because I thought that value represented the row count that I wanted to search through.

Regards,
Chris

 

[John Davis]

Hi John,

You're correct that there aren't 1000 columns in my workbook. I entered 1000 because I thought that value represented the row count that I wanted to search through.

Regards,
Chris

The code would not work as you have it because it is looking for Column 1000. In my original I had 9. The 9 represented Column I. Try changing that back and see what happens.