Macro help needed! Excel2003

[LolaM]

Hi Folks,

I need some help constructing some VBA code which will do the following:

1. Search col A of Sheet1 for the first instance of a specific text string (which starts "For Model" with potentially multiple returns, e.g. "For Model 1234", "For Model 4567", etc).
2. Stop search at cell in col A containing the word "Key".
3. Copy all of the cells in col A between these two cells found in the 2 steps above.
4. Paste values and formatting - especially cell pattern - to cell A1 on Sheet2.
5. THEN... from the first instance of the text found in step 1 above, copy and paste col B for the same range of cells to Sheet2, cell E1.
6. THEN... from the first instance of the text found in step 1 above, copy and paste col C for the same range of cells to Sheet2, cell J1.
7. THEN... from the first instance of the text found in step 1 above, copy and paste col D for the same range of cells to Sheet2, cell O1.

Hope this makes sense!!

Basically I have a web query which imports a 4-column table data (with variable rows and/or variable numbers of tables with variable numbers of rows!) from a webpage, I need to copy and paste this into another worksheet and space each column of data out so it can be merged across multiple columns to make it easier to read. The original web query import is in full HTML, so this imports the table formatting as well - and the background colour in particular must be copied across as this is the part (along with text) most likely to change.

The only constant on the web import query is that the range I want to copy starts with a cell in col A which has the text "For Model [model #]" (there may be more than one instance of this!) and the last cell I want to copy is the row before the cell which has text "Key" in it.

Any code/suggestions/assistance would be fantastic! Thanks in advance
LolaM

 

[bertie]

Here is the sample data I used for testing the code.

Sheet1

<table style="font-family:Calibri,Arial; font-size:11pt; background-color:#ffffff; padding-left:2pt; padding-right:2pt; " border="1" cellpadding="0" cellspacing="0"> <colgroup><col style="font-weight:bold; width:30px; "><col style="width:102px;"><col style="width:102px;"><col style="width:102px;"><col style="width:102px;"></colgroup><tbody><tr style="background-color:#cacaca; text-align:center; font-weight:bold; font-size:8pt; "><td>
</td><td>A</td><td>B</td><td>C</td><td>D</td></tr><tr style="height:18px ;"><td style="font-size:8pt; background-color:#cacaca; text-align:center; ">1</td><td style="font-weight:bold; ">Header A</td><td style="font-weight:bold; ">Header B</td><td style="font-weight:bold; ">Header C</td><td style="font-weight:bold; ">Header D</td></tr><tr style="height:18px ;"><td style="font-size:8pt; background-color:#cacaca; text-align:center; ">2</td><td>x</td><td>x</td><td>x</td><td>x</td></tr><tr style="height:18px ;"><td style="font-size:8pt; background-color:#cacaca; text-align:center; ">3</td><td style="background-color:#ccccff; ">For Model 1234</td><td style="background-color:#ccccff; ">For Model 1234</td><td style="background-color:#ccccff; ">For Model 1234</td><td style="background-color:#ccccff; ">For Model 1234</td></tr><tr style="height:18px ;"><td style="font-size:8pt; background-color:#cacaca; text-align:center; ">4</td><td style="background-color:#ccccff; ">a</td><td style="background-color:#ccccff; ">b</td><td style="background-color:#ccccff; ">c</td><td style="background-color:#ccccff; ">d</td></tr><tr style="height:18px ;"><td style="font-size:8pt; background-color:#cacaca; text-align:center; ">5</td><td style="background-color:#ccccff; ">Key</td><td style="background-color:#ccccff; ">Key</td><td style="background-color:#ccccff; ">Key</td><td style="background-color:#ccccff; ">Key</td></tr><tr style="height:18px ;"><td style="font-size:8pt; background-color:#cacaca; text-align:center; ">6</td><td>x</td><td>x</td><td>x</td><td>x</td></tr></tbody></table>




I created a FIND function which searches column A on Sheet1.
The text to "find" is passed to the function which returns the row number the text was found on.

  rowStart = FindRow("For Model*")
  rowEnd = FindRow("Key")

These values are then used to set the ranges for copying and pasting.

The code should be placed in the ThisWorkbook module.

[COLOR=darkblue]Sub[/COLOR] Main()
  [COLOR=darkblue]Dim[/COLOR] rowStart [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
  [COLOR=darkblue]Dim[/COLOR] rowEnd [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]

  rowStart = FindRow("For Model*")
  rowEnd = FindRow("Key")
  
  [COLOR=green]'check the value is found[/COLOR]
  [COLOR=darkblue]If[/COLOR] rowStart = 0 [COLOR=darkblue]Or[/COLOR] rowEnd = 0 [COLOR=darkblue]Then[/COLOR]
    MsgBox "Value not found!"
    [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
  [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
  
  [COLOR=green]'copy and paste[/COLOR]
  [COLOR=darkblue]With[/COLOR] Sheets("Sheet1")
    [COLOR=green]'column A[/COLOR]
    .Range("A" & rowStart & ":A" & rowEnd).Copy _
      Destination:=Sheets("Sheet2").Range("A1")
    [COLOR=green]'column B[/COLOR]
    .Range("B" & rowStart & ":B" & rowEnd).Copy _
      Destination:=Sheets("Sheet2").Range("E1")
    [COLOR=green]'column C[/COLOR]
    .Range("C" & rowStart & ":C" & rowEnd).Copy _
      Destination:=Sheets("Sheet2").Range("J1")
    [COLOR=green]'column D[/COLOR]
    .Range("D" & rowStart & ":D" & rowEnd).Copy _
      Destination:=Sheets("Sheet2").Range("O1")
  [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
  
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]


[COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Function[/COLOR] FindRow([COLOR=darkblue]ByVal[/COLOR] txt [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]) [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
  [COLOR=green]'returns the row from a Find function[/COLOR]
  [COLOR=darkblue]Dim[/COLOR] rng [COLOR=darkblue]As[/COLOR] Range
    [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]Resume[/COLOR] [COLOR=darkblue]Next[/COLOR]

    [COLOR=darkblue]With[/COLOR] Sheets("Sheet1")
        [COLOR=darkblue]Set[/COLOR] rng = .Columns(1).Find(What:=txt, _
                              After:=.Cells(1, 1), _
                              LookIn:=xlValues, _
                              LookAt:=xlPart, _
                              SearchOrder:=xlByRows, _
                              SearchDirection:=xlNext, _
                              MatchCase:=False, _
                              SearchFormat:=False)
    [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]GoTo[/COLOR] 0

        [COLOR=darkblue]If[/COLOR] [COLOR=darkblue]Not[/COLOR] rng [COLOR=darkblue]Is[/COLOR] [COLOR=darkblue]Nothing[/COLOR] [COLOR=darkblue]Then[/COLOR]
          FindRow = rng.Row
        [COLOR=darkblue]Else[/COLOR]
          FindRow = 0
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Function[/COLOR]

 

[LolaM]

Thanks for this... will have a play with it!