Is there a way to use the find function to identify a column with value only of a specific length?-CodePudding

I need to make a macro which asks the user to select an excel file, then goes through each column (without headers), identifies the column who values have a length of only 7 and copy it into the original excel where the macro is.

Sub Upload()

InitializeSettings

Dim FindOrdernummer As Range
Dim FileToOpen As Variant
Dim OpenBook As Workbook

Application.ScreenUpdating = False
FileToOpen = Application.GetOpenFilename("Excel Files (*.xls; *.xlsx), *.xls; *.xlsx", , "Browse for your File & Import")
If FileToOpen <> False Then
  Set OpenBook = Application.Workbooks.Open(FileToOpen)
  OpenBook.Sheets(1).Range("A1:Z70").Find
End If


Application.ScreenUpdating = True
End Sub

I am thinking of making a for loop but i am unable to code the part where it looks through the entire column and not just a particular cell.

Help would be much appreciated on this seemingly simple matter!

CodePudding user response：

Unfortunately you can't select all cells at once that have a value with a length of 7, so you need to go through all the cells in the column to check.

You can do that with a for loop and it would look something like this:

Dim r As Range
Dim col As Range
Dim ws As worksheet

Set worksheet = Application.ActiveSheet
Set r = ws.Range("A1:Z70")

For Each col In r.Columns
    Dim copyColumn As Boolean
    copyColumn = True 'make sure you reset this variable for every column
    
    For i = 1 To 70
        If Len(ws.Cells(i, col.Column).Value) <> 7 Then
            copyColumn = False
            Exit For
            'If one of the cells does not have a value with a length of 7,
            'you can stop the loop and continue to the next column
        Next
    Next i
    
    If copyColumn = True Then
        'Copy the column
    End If

Next col

CodePudding user response：

This Loop should list all the Value that length is 7.

        Option Explicit
        Dim MacroWb As Workbook
        
        Sub Upload()
        
        InitializeSettings
        
        Dim FindOrdernummer As Range
        Dim FileToOpen As Variant
        Dim OpenBook As Workbook
        
        Set MacroWb = ThisWorkbook
        
        
        Application.ScreenUpdating = False
        FileToOpen = Application.GetOpenFilename("Excel Files (*.xls; *.xlsx), *.xls; *.xlsx", , "Browse for your File & Import")
        If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        Call FindValuesWithlengtOfSeven
        End If
        
        
        Application.ScreenUpdating = True
        End Sub
        
        Sub FindValuesWithlengtOfSeven()
        Dim rng As Range
        Dim cel As Range
        Dim Occurrence As Long
        
        Occurrence = 1
        
        Set rng = OpenBook.Sheets(1).Range("A1:Z70")
        
        For Each cel In rng
            If Len(cel.Value) = 7 Then
        '********** Change it to the sheet name you want to put the list "TheNameOfTheSheet"
                MacroWb.Sheets("TheNameOfTheSheet").Range("A" & Occurrence).Value = cel.Value
                Occurrence = Occurrence   1
            End If
        Next cel
        
        Set rng = Nothing
        
        End Sub