Variable Column Loop

B

breynolds0431

Active Member
Joined
Feb 15, 2013
Messages
303
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I've fallen into a big hole with this issue. I have a userform that compiles all the columns on a sheet in a listbox. The user goes through selecting the column and indicating the data type (date/time, text, or numeric). That information is written to a separate sheet, which will be used externally to verify all data types were properly matched/identified. The userform works fine. My goal was to use the defined data types and run some loops through the data sheet to ensure each column's cells is what was indicated in the userform (e.g.; column of payment dates should not have any text). If an issue like that is found, it's written to another sheet that compiles all the errors. Each error will be written to the sheet with the sheet's name, corresponding cell address, and error type.

What I can't figure out is how to loop through the variable column (column headers will very drastically between different sheets) after determining it's data type and checking each cell within. Here is what I have so far. But, I receive the "For Each can only iterate over a collection object or an array" error on the cell.column part, which was my longshot approach for determining the column of the current column header's data type. And I'm sure there are other errors waiting for the cell.column issue to be resolved. I greatly appreciate any time that is spent looking through this.

VBA Code: 
Private Sub cbVerify_Click()

Dim sSheet As String: sSheet = "IPXO" 'Source sheet; needs to be changed to a variable, but using static for testing
Dim lRow As Long: lRow = Sheets(sSheet).UsedRange.Rows(Sheets(sSheet).UsedRange.Rows.Count).Row
Dim lCol As Long: lCol = Sheets(sSheet).UsedRange.Columns(Sheets(sSheet).UsedRange.Columns.Count).Column

Dim cell As Range

For Each cell In Sheets(sSheet).Rows(1) 'Looks through the first row (which are the column headers)

Dim dVerify As Worksheet: Set dVerify = ThisWorkbook.Sheets("ColData") 'Sheet that has the column headers and their defined data types
Dim shCol As Variant: shCol = Application.WorksheetFunction.Match(sSheet, dVerify.Rows(1), 0)
Dim var As Variant
Dim dv As Worksheet: Set dv = ThisWorkbook.Sheets("Data Verify") 'Sheet that any errors found in sSheet will be written to
Dim lrowDV As Long

Dim rng As Range: rng = Sheets(sSheet).CurrentRegion

'converts any formulas to values
          Dim fCell As Range
          For Each fCell In rng
                    If fCell.HasFormula Then
                              fCell.Formula = fCell.Value
                    End If
          Next fCell

' Verifies no blanks
          Dim bCell As Range
          For Each bCell In rng
                If IsEmpty(bCell.Value) Or bCell.Value = vbNullString Then
                     With dv
                          lrowDV = dv.Cells(dv.Rows.Count, "C").End(xlUp).Row
                               With dv
                                         .Activate
                                         .Cells(lrowDV + 1, 2).Value = sSheet
                                         .Cells(lrowDV + 1, 3).Value = bCell.Address
                                         .Cells(lrowDV + 1, 4).Value = "Blank Cell"
                               End With
                     End With
                End If
           Next bCell

          var = Application.WorksheetFunction.VLookup(cell, dVerify.Range("A:AA"), shCol, False)
         
          If var = "Date/Time" Then
          ' Will ensure Date Format
                    Dim dCell As Range
                    For Each dCell In cell.Column
                              If Not IsDate(dCell.Value) Then
                                   If dCell.Row = 1 Then
                                   Else
                                        With dv
                                             lrowDV = dv.Cells(dv.Rows.Count, "C").End(xlUp).Row
                                                  With dv
                                                            .Activate
                                                            .Cells(lrowDV + 1, 2).Value = sSheet
                                                            .Cells(lrowDV + 1, 3).Value = dCell.Address
                                                            .Cells(lrowDV + 1, 4).Value = "Date Format Error"
                                                  End With
                                        End With
                                   End If
                              End If
                    Next dCell
         
          ElseIf var = "Text" Then
          ' Will review data indicated as Text to not be in number format
                    Dim tCell As Range
                    For Each tCell In cell.Column
                              If IsNumeric(tCell.Value) Then
                                   If tCell.Row = 1 Then
                                   Else
                                        With dv
                                             lrowDV = dv.Cells(dv.Rows.Count, "C").End(xlUp).Row
                                                  With dv
                                                            .Activate
                                                            .Cells(lrowDV + 1, 2).Value = sSheet
                                                            .Cells(lrowDV + 1, 3).Value = tCell.Address
                                                            .Cells(lrowDV + 1, 4).Value = "Text Format Error"
                                                  End With
                                        End With
                                   End If
                              End If
                    Next tCell
         
          ElseIf var = "Numeric" Then
          ' Will ensure Number Format
                    Dim nCell As Range
                    For Each nCell In cell.Column
                              If Not IsNumeric(nCell.Value) Then
                                   If nCell.Row = 1 Then
                                   Else
                                        With dv
                                             lrowDV = dv.Cells(dv.Rows.Count, "C").End(xlUp).Row
                                                  With dv
                                                            .Activate
                                                            .Cells(lrowDV + 1, 2).Value = sSheet
                                                            .Cells(lrowDV + 1, 3).Value = nCell.Address
                                                            .Cells(lrowDV + 1, 4).Value = "Numeric Format Error"
                                                  End With
                                        End With
                                   End If
                              End If
                    Next nCell
         
          Else
          End If
Next cell

End Sub
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
Sort by date Sort by votes
I am not sure your loop actually makes sense.
For Each cell In Sheets(sSheet).Rows(1)
This looping through every column in the spreadsheet which seems terribly inefficient
cell.column is a single cell (in row 1).
The the various flavours of loops For Each dCell In cell.Column
are trying to loop through a single cell, that is why you are getting the error message.
 
Upvote 0
Alex Blakenburg said:
I am not sure your loop actually makes sense.
For Each cell In Sheets(sSheet).Rows(1)
This looping through every column in the spreadsheet which seems terribly inefficient
cell.column is a single cell (in row 1).
The the various flavours of loops For Each dCell In cell.Column
are trying to loop through a single cell, that is why you are getting the error message.
Click to expand...
Thanks for your time. Any offerings to a solution? Maybe I should rewrite what the objective is?
 
Upvote 0
I think you're trying to loop through rng column by column, applying different checks depending on the type of column?

Here's one way you can loop through cells, column by column:

VBA Code: 
Sub Test()
 
    Dim rng As Range, c As Range, cel As Range
    Dim c1 As Long, c2 As Long
        
    Set rng = Range("A1:B2")
    For Each c In rng.Columns
        c1 = c1 + 1
        MsgBox "column " & c1 & " is " & c.Address
        c2 = 0
        For Each cel In c.Cells
            'I think you want to do stuff here depending on the column type?
            c2 = c2 + 1
            MsgBox "cell " & c2 & " is " & cel.Address
        Next cel
    Next c
 
End Sub

I agree with Alex - you appear to be looping unnecessarily. You have:

Code: 
For Each cell In Sheets(sSheet).Rows(1)
    For Each fCell In rng
        'etc

which in theory will loop through every cell in rng 16,384 times, i.e. the number of cells in .Rows(1). But there is a glitch in Excel, if you try to loop through a single row or single column using For Each, the loop iterates only once. Hence in my code I have said:
For Each cel In c.Cells which is one way to workaround this.

I also noticed this line isn't valid:
rng = Sheets(sSheet).CurrentRegion

You need to Set a range object, and .CurrentRegion is a Range property, not a Worksheet property, e.g.
Set rng = Sheets(sSheet).Range("A1").CurrentRegion (which may not capture the whole .UsedRange)
 
Upvote 0
Solution
Oops cell.column returns a column number which is why it is failing (not a single cell)
 
Upvote 0
I really appreciate the thoughts on this and thank you for bearing with me. I know this is not a very elegant approach, but it's the best I could come up with.

One thing I should point out is that the loop through row 1 (i.e.; For Each cell In Sheets(sSheet).Rows(1) 'Looks through the first row (which are the column headers)) will check the column's name on the ColData sheet and should return the corresponding data type. This is done with the var = Application.WorksheetFunction.VLookup(cell, dVerify.Range("A:AA"), shCol, False) VLOOKUP. The ColData is screenshot below.

1639855438688.png


Stephan, I looked at your example, but I wouldn't be able to specify the rng (i.e.; Set rng = Range("A1:B2")), as that will always be a variable. Maybe I should add a column count, such as For Each cell In Sheets(sSheet).Range(Rows(1), lCol) 'Looks through the first row (which are the column headers) to stop it from going beyond the last used column?

Then, what I was thinking I had to do was loop through each cell within that column based on the data type (Date/Time, Text, or Numeric) that was found in the var VLOOKUP. My thought was that cell.column would have indicated to run the loop for all cells within the column the For Each cell In Sheets(sSheet).Rows(1) was on. But, per Alex, that won't work.

I just need to identify each column's specified data type and loop through only that column to test each cell to ensure it is the intended data type. And then move onto the next column and test it's cells.

I did make the update on the .CurrentRegion issue. I also moved the formula conversion and blank check loops out of the For Each cell in row 1 loop, as those should check all cells without regard to the column's data type.

Any other thoughts on how to have all cells data verified in one column at a time?

VBA Code: 
Private Sub cbVerify_Click()

Dim sSheet As String: sSheet = "IPXO" 'Source sheet; needs to be changed to a variable, but using static for testing
Dim lRow As Long: lRow = Sheets(sSheet).UsedRange.Rows(Sheets(sSheet).UsedRange.Rows.Count).Row
Dim lCol As Long: lCol = Sheets(sSheet).UsedRange.Columns(Sheets(sSheet).UsedRange.Columns.Count).Column
Dim dVerify As Worksheet: Set dVerify = ThisWorkbook.Sheets("ColData") 'Sheet that has the column headers and their defined data types
Dim shCol As Variant: shCol = Application.WorksheetFunction.Match(sSheet, dVerify.Rows(1), 0)
Dim var As Variant
Dim dv As Worksheet: Set dv = ThisWorkbook.Sheets("Data Verify") 'Sheet that any errors found in sSheet will be written to
Dim lrowDV As Long
Dim cell As Range
Dim rng As Range: rng = Sheets(sSheet).Range("A1").CurrentRegion

'converts any formulas to values
          Dim fCell As Range
          For Each fCell In rng
                    If fCell.HasFormula Then
                              fCell.Formula = fCell.Value
                    End If
          Next fCell

' Verifies no blanks
          Dim bCell As Range
          For Each bCell In rng
                If IsEmpty(bCell.Value) Or bCell.Value = vbNullString Then
                     With dv
                          lrowDV = dv.Cells(dv.Rows.Count, "C").End(xlUp).Row
                               With dv
                                         .Activate
                                         .Cells(lrowDV + 1, 2).Value = sSheet
                                         .Cells(lrowDV + 1, 3).Value = bCell.Address
                                         .Cells(lrowDV + 1, 4).Value = "Blank Cell"
                               End With
                     End With
                End If
           Next bCell

For Each cell In Sheets(sSheet).Range(Rows(1), lCol) 'Looks through the first row (which are the column headers)

          var = Application.WorksheetFunction.VLookup(cell, dVerify.Range("A:AA"), shCol, False)
          
          If var = "Date/Time" Then
          ' Will ensure Date Format
                    Dim dCell As Range
                    For Each dCell In cell.Column
                              If Not IsDate(dCell.Value) Then
                                   If dCell.Row = 1 Then
                                   Else
                                        With dv
                                             lrowDV = dv.Cells(dv.Rows.Count, "C").End(xlUp).Row
                                                  With dv
                                                            .Activate
                                                            .Cells(lrowDV + 1, 2).Value = sSheet
                                                            .Cells(lrowDV + 1, 3).Value = dCell.Address
                                                            .Cells(lrowDV + 1, 4).Value = "Date Format Error"
                                                  End With
                                        End With
                                   End If
                              End If
                    Next dCell
          
          ElseIf var = "Text" Then
          ' Will review data indicated as Text to not be in number format
                    Dim tCell As Range
                    For Each tCell In cell.Column
                              If IsNumeric(tCell.Value) Then
                                   If tCell.Row = 1 Then
                                   Else
                                        With dv
                                             lrowDV = dv.Cells(dv.Rows.Count, "C").End(xlUp).Row
                                                  With dv
                                                            .Activate
                                                            .Cells(lrowDV + 1, 2).Value = sSheet
                                                            .Cells(lrowDV + 1, 3).Value = tCell.Address
                                                            .Cells(lrowDV + 1, 4).Value = "Text Format Error"
                                                  End With
                                        End With
                                   End If
                              End If
                    Next tCell
          
          ElseIf var = "Numeric" Then
          ' Will ensure Number Format
                    Dim nCell As Range
                    For Each nCell In cell.Column
                              If Not IsNumeric(nCell.Value) Then
                                   If nCell.Row = 1 Then
                                   Else
                                        With dv
                                             lrowDV = dv.Cells(dv.Rows.Count, "C").End(xlUp).Row
                                                  With dv
                                                            .Activate
                                                            .Cells(lrowDV + 1, 2).Value = sSheet
                                                            .Cells(lrowDV + 1, 3).Value = nCell.Address
                                                            .Cells(lrowDV + 1, 4).Value = "Numeric Format Error"
                                                  End With
                                        End With
                                   End If
                              End If
                    Next nCell
          Else
          End If
Next cell

End Sub
 
Upvote 0
Stephen! I modified your suggestion a bit and it works.

Below is what I ended up with. I'm not sure what c2 was supposed to do.

Code: 
Sub verifydata()

Dim sSheet As String: sSheet = "IPXO" 'Source sheet; needs to be changed to a variable, but using static for testing
Dim lRow As Long: lRow = Sheets(sSheet).UsedRange.Rows(Sheets(sSheet).UsedRange.Rows.Count).Row
Dim lCol As Long: lCol = Sheets(sSheet).UsedRange.Columns(Sheets(sSheet).UsedRange.Columns.Count).Column
Dim dVerify As Worksheet: Set dVerify = ThisWorkbook.Sheets("ColData") 'Sheet that has the column headers and their defined data types
Dim shCol As Variant: shCol = Application.WorksheetFunction.Match(sSheet, dVerify.Rows(1), 0)
Dim dv As Worksheet: Set dv = ThisWorkbook.Sheets("Data Verify") 'Sheet that any errors found in sSheet will be written to
Dim var As Variant
Dim lrowDV As Long
Dim rng As Range: Set rng = Sheets(sSheet).UsedRange

'converts any formulas to values
          Dim fCell As Range
          For Each fCell In rng
                    If fCell.HasFormula Then
                              fCell.Formula = fCell.Value
                    End If
          Next fCell

' Verifies no blanks
          Dim bCell As Range
          For Each bCell In rng
                If IsEmpty(bCell.Value) Or bCell.Value = vbNullString Then
                     With dv
                          lrowDV = dv.Cells(dv.Rows.Count, "C").End(xlUp).Row
                               With dv
                                         .Activate
                                         .Cells(lrowDV + 1, 2).Value = sSheet
                                         .Cells(lrowDV + 1, 3).Value = bCell.Address
                                         .Cells(lrowDV + 1, 4).Value = "Blank Cell"
                               End With
                     End With
                End If
           Next bCell

Dim c As Range, cel As Range
Dim c1 As Long, c2 As Long

For Each c In rng.Columns
c1 = c1 + 1
c2 = 0

          var = Application.WorksheetFunction.VLookup(Sheets(sSheet).Cells(1, c1), dVerify.Range("A:AA"), shCol, False)
          
          If IsError(var) Then
          Else
                    If var = "Date/Time" Then
                              For Each cel In c.Cells
                                        If Not IsDate(cel.Value) Then
                                             If cel.Row = 1 Then
                                             Else
                                                  With dv
                                                       lrowDV = dv.Cells(dv.Rows.Count, "C").End(xlUp).Row
                                                            With dv
                                                                      .Activate
                                                                      .Cells(lrowDV + 1, 2).Value = sSheet
                                                                      .Cells(lrowDV + 1, 3).Value = cel.Address
                                                                      .Cells(lrowDV + 1, 4).Value = "Date Format Error"
                                                            End With
                                                  End With
                                             End If
                                        End If
                              Next cel
                    ElseIf var = "Text" Then
                              For Each cel In c.Cells
                                        If IsNumeric(cel.Value) Then
                                             If cel.Row = 1 Then
                                             Else
                                                  With dv
                                                       lrowDV = dv.Cells(dv.Rows.Count, "C").End(xlUp).Row
                                                            With dv
                                                                      .Activate
                                                                      .Cells(lrowDV + 1, 2).Value = sSheet
                                                                      .Cells(lrowDV + 1, 3).Value = cel.Address
                                                                      .Cells(lrowDV + 1, 4).Value = "Text Format Error"
                                                            End With
                                                  End With
                                             End If
                                        End If
                              Next cel
                    ElseIf var = "Numeric" Then
                              For Each cel In c.Cells
                                         If Not IsNumeric(cel.Value) Then
                                             If cel.Row = 1 Then
                                             Else
                                                  With dv
                                                       lrowDV = dv.Cells(dv.Rows.Count, "C").End(xlUp).Row
                                                            With dv
                                                                      .Activate
                                                                      .Cells(lrowDV + 1, 2).Value = sSheet
                                                                      .Cells(lrowDV + 1, 3).Value = cel.Address
                                                                      .Cells(lrowDV + 1, 4).Value = "Numeric Format Error"
                                                            End With
                                                  End With
                                             End If
                                        End If
                              Next cel
                    End If
          End If
Next c

End Sub

I tested by intentionally changing some test data and the results were spot on.

1639862615964.png
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question
Combining VBA code together...need help!
Replies
3
Views
166
Fluff
Fluff
A
  • Locked
  • Solved
Edit the code to Multiple Columns
Replies
2
Views
114
Fluff
Fluff
F
  • Question
vba to extract address
Replies
7
Views
840
Peter_SSs
Peter_SSs
S
  • Question
CSV export to remove column
Replies
1
Views
85
StellarRumble59
S
M
  • Question
Preserve data validation input messages when dragging
Replies
4
Views
521
matt767
M

Forum statistics

Threads
1,214,834
Messages
6,121,873
Members
449,056
Latest member
ruhulaminappu

Share this page

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
Back
Top