MS Excel VBA extract records with a marker and place into a worksheet.

[bbcdancer]

****** content="Microsoft SafeHTML" name=Generator><STYLE>.ExternalClass .ecxhmmessage P{padding:0px;}.ExternalClass body.ecxhmmessage{font-size:10pt;font-family:Tahoma;}</STYLE>Tried to write VBA and became rather puzzled in how to do this in VBA.

I have a table (Table C) located in the current worksheet.

The current worksheet name may vary and not a constant name.

'Table C' cell area extents from J8:U1000

The first column in 'Table C' (J8:J1000), some cells will contain a marker denoted with the character letter "A" and the other cells will be blank \ empty.


The aim of this marco is to:

1. Go through each record in 'Table C' with reference to to identifying if each record has a marker "A" text in column J.

2. If the record has a "A" marker in column J:

a) Copy the current targeted row record range (For example, K8:U8, which excludes cell J8) and paste the values\text only of this record data into table (Table F) found in a worksheet call "output". The 'Table F' table starts at cell B5 in the worksheet called "output".

b) Next, move back to the current worksheet and proceed onto the next record down in 'Table C'.

3. If no record has a "A" marker, in column J, then move onto the next record down in 'Table C'.

4. If another record has a "A" marker in column J. Then repeat point 2 (note: different row data ranges) and add this target record data to the other records found in 'Table F' in the worksheet call "output".

5. Continue on examining all of the records in 'Table C' until all 992 records have been examined and all identified "A" records are copied to over to 'Table F'.

Is this doable in VBA without using the MS Excel filters with bulk copy and paste, as I find this route is less flexible in understanding how array coding and looping works.

Any help is appreciated.

Many thanks in advance.

Brenda

 

[Jerry Sullivan]

Hi Brenda,

Yes, what you describe is doable using VBA. There are a few approaches that would work that don't require filter or bulk copy:

1. Read all of Table C into an Array and process each Row of the Array without having to go back to Table C.

2. Read the first Column J into a 1-Dimensional Array. Build a separate 1-Dim Array that stores the Row numbers that start with text "A", then read / write those rows to Table F

3. Step through each Row of Col J and each time an "A" is found then read/ write those rows to Table F.

Since it sounds like you are interested in learning specific coding techniques instead of merely obtaining a solution, which one of those would be most helpful?

Also please clarify:

A. When you say "Table C", are you referring to a Data Table or just a Range? In xl2007 Data Tables can't have spaces in their names so I might be misunderstanding.

B. Do you have a preference whether the data type of the Array used in the example is a Variant or String() Array?

 

[bbcdancer]

Hi JS411,

So many solutions.

I think option 2 or 3 is more in tuned with my aims. Is working with arrays in option 2 better than option 3? I fear that option 1 is not flexible enough because some blank rows in table C are used as summary headers or merged together with other row cells, which I would not like to examine and extract or might corrupt the Array.


a) Its a range. I have not defined this table C area in MS Excel.

b) Variant is more flexible than String, but I think the correct one would be String because the internet says it more efficient in coding than variant.

 

[Jerry Sullivan]

Brenda,

Here is some code that you can try. It follows the first approach outlined previously. I realize you thought option 2 or 3 would be best but it sounded like your only reservation on option 1 was that it might not work with blank rows and merged cells. This example should handle those conditions.

Sub Copy_Marked_Rows()
    Dim varArray As Variant
    Dim lngCol As Long, lngRow As Long
    Dim rngNext As Range
    Application.ScreenUpdating = False
 
    If ActiveSheet.Name = "output" Then
        MsgBox "Change to a sheet other than ""output"" "
        Exit Sub
    End If
    '---read Table C into Array
    varArray = ActiveSheet.Range("$J$9:$U$1000")
 
    With Sheets("output")
        Set rngNext = .Range("B4") 'Assumed Header Row- Left Col
        For lngRow = LBound(varArray, 1) To UBound(varArray, 1)
        '---test each row for marker
            If varArray(lngRow, 1) = "A" Then
               '---if marker found, write row to Table F
                Set rngNext = rngNext.Offset(1)
                For lngCol = LBound(varArray, 2) + 1 To UBound(varArray, 2)
                    rngNext.Offset(0, lngCol - 2) = varArray(lngRow, lngCol)
                Next lngCol
            End If
        Next lngRow
    End With
 
    '---clean up to release memory
    Set rngNext = Nothing
    Erase varArray
End Sub

Hopefully you'll be able to follow along the control sequence and see how the array is being written into, tested, and written from.

Just ask if you have any questions.

 

[bbcdancer]

Thanks for the example code.

I was testing the code and came across two minor issues that I forgot to take into account.

1. Can the search text be adaptable to both upper case "A" and lower case "a".

Something like this:
" If varArray(lngRow, 1) = "A" And "a" Then"

2. The array data get pasted to Range("B4"), is it possible for the marco to identify the last record in the table F and then add by pasting the data on the existing list. Somehow, I need to keep an audit of the prior records created prior to running the marco.

 

[Jerry Sullivan]

Hi Brenda,

1. Can the search text be adaptable to both upper case "A" and lower case "a".

Revise to:

If UCase(varArray(lngRow, 1)) = "A" Then

is it possible for the marco to identify the last record in the table F and then add by pasting the data on the existing list.

'Replace:
Set rngNext = .Range("B4") 'Assumed Header Row- Left Col
 
'with
Set rngNext =  .Cells(Rows.Count, 2).End(xlUp)

Good luck!

 

[Jerry Sullivan]

Correcting my last post: The last revision finds the last row in Col B with data.
Since you want to append your list, the code should set rngNext to be the blank cell one row below that.

'Replace:
Set rngNext = .Range("B4") 'Assumed Header Row- Left Col
 
'with
Set rngNext =  .Cells(.Rows.Count, 2).End(xlUp).Offset(1)

 

[bbcdancer]

JS411,

Thank you for your help.

Much appreciated.