VBA - loop through multiple rows/columns

pauleverton

New Member
Joined
Feb 8, 2014
Messages
23
Hi,

I'm trying to do a check against a few thousand rows to see if they contain the information within a column header - data is as below:

Columns A:Z - Information that we want to check
Columns AA:AZ - Row 1 contains the headers we want to validate, rows 2 & below contain where we need to put the results

I've put a brief example below - the aim is to check each value in each row to see if it contains the specific column header and, if so, output how many files on that row contain that information.

File 1File 2File 3File 4...File ZABC123XYZ8910
eakgABC1232234123ABCXYZ89102211
xxxxxxyyyyyyzzzzzz111122220000
ABC123XYZABC12389102201

I've tried to create a double loop with an incremental count but it's just not processing as I want and I'm a bit stumped as to how to get this moving - any help would be really appreciated.

Thanks,

Paul
 

Some videos you may like

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN

pauleverton

New Member
Joined
Feb 8, 2014
Messages
23
Through trial & error I've managed to get the below to work, but it's quite inefficient - at the moment, it's taking about 1.5 minutes to go through 1,000 rows, and the spreadsheet can contain upwards of 10,000 rows - any suggestions on how I can improve the timings?

VBA Code:
Sub test()

Dim query As Worksheet
Set query = Worksheets("Query result")

Dim timings As Worksheet
Set timings = Worksheets("Timings")

timings.[a2] = Now()

Dim lastrow As Long
Dim rownum As Long

rownum = 2
lastrow = query.Cells(query.Rows.Count, "AA").End(xlUp).Row

'Range for file counts - file indicator in this column
Dim id As Range
Dim idrange As Range
Set idrange = Range("AA" & rownum & ":AA" & lastrow)

'Range for file details
Dim log As Range
Dim logrange As Range

'Range for file types
Dim filetype As Range
Dim filerange As Range
Set filerange = Range("AB1:AZ1")

'Range to update
Dim updaterange As Range

For Each id In idrange

Set logrange = Range("A" & rownum & ":Z" & rownum)
Set updaterange = Range("AB" & rownum & ":AZ" & rownum)

    offsetnum = 1
   
    For Each filetype In filerange
        Count = 0
        For Each log In logrange
                If InStr(UCase(log), UCase(filetype)) Then
                    Count = Count + 1
                End If
        Next
       
    id.Offset(0, offsetnum) = Count
    offsetnum = offsetnum + 1
    Next
   
rownum = rownum + 1

'Set at 1000 to get timing data - need to remove
If rownum = 1000 Then
    timings.[b2] = Now()
    Exit Sub
End If

Next

End Sub
 

mse330

Well-known Member
Joined
Oct 18, 2007
Messages
711
Office Version
  1. 365
Platform
  1. Windows
Hi Paul,

Try below code ...
VBA Code:
Sub test()

Dim a, b
a = Range("A1", Range("A" & Rows.Count).End(3)).Resize(, 26)
b = Range("AA1:AZ1").Resize(UBound(a))

For i = 1 To 26
   For x = 2 To UBound(a)
      For y = 1 To 26
         If InStr(a(x, y), b(1, i)) Then b(x, i) = b(x, i) + 1
      Next
   Next
Next

Range("AA1").Resize(UBound(b), 26) = b

End Sub
 

Osvaldo Palmeiro

Well-known Member
Joined
Feb 24, 2009
Messages
610
Office Version
  1. 365
Platform
  1. Windows
Hi, Paul.
Try this.
VBA Code:
Sub CountStrings()
 With Range("AA2:AZ2").Resize(Cells(Rows.Count, 1).End(3).Row - 1)
  .Formula = "=COUNTIF($A2:$Z2,""*""&AA$1&""*"")"
  .Value = .Value
 End With
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,123,346
Messages
5,601,087
Members
414,426
Latest member
fraru

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top