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

[kanishkgarg]

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!

 

[mikerickson]

To use the .Find method to find a string of 7 characters, you could use pattern matching, as in

Set foundCell = Cells.Find("???????")

Are you looking for a column where all the cells have 7 characters or a column where some cell has seven characters?

 

[kanishkgarg]

I am looking for a column where all cells have 7 characters. and then later paste it into the excel with the macro.

 

[mikerickson]

You could loop through each column and test

If WorksheetFunction.CountIf(thisColumn, "???????") = WorksheetFunction.CountA(thisColumn) Then

 

[kanishkgarg]

You could loop through each column and test

If WorksheetFunction.CountIf(thisColumn, "???????") = WorksheetFunction.CountA(thisColumn) Then

But how do i enter the length function and make it run through the whole sheet? I am sorry but this one line doesnt help me.

 

[mikerickson]

LEN isn't needed unless you want to test each cell one at a time. By using the wildcard characters in COUNTIF, you can test a whole column for at one go rather than looping through each cell.

What is your current code for copying the column once it is found?

 

[kanishkgarg]

LEN isn't needed unless you want to test each cell one at a time. By using the wildcard characters in COUNTIF, you can test a whole column for at one go rather than looping through each cell.

What is your current code for copying the column once it is found?

If Len(cel.Value) = 7 Then
        
                MacroWb.Sheets("TheNameOfTheSheet").Range("A" & Occurrence).Value = cel.Value

It looks like something like this

 

[mikerickson]

Try something like

Dim oneColumn as Range

For Each oneColumn in SourceSheet.Columns
    If WorksheetFunction.CountIf(oneColumn, String(7, "?")) = WorksheetFunction.CountA(oneColumn) Then
        With DestinationSheet.Cells(1, Columns.Count).End(xlToLeft).Offset(0,1).EntireColumn
            .Value = oneColumn.Value
        End With
    End If
Next oneColumn

You would need to have the SourceSheet and DestiationSheet set before that code runs.

 

[kanishkgarg]

Try something like

Dim oneColumn as Range

For Each oneColumn in SourceSheet.Columns
    If WorksheetFunction.CountIf(oneColumn, String(7, "?")) = WorksheetFunction.CountA(oneColumn) Then
        With DestinationSheet.Cells(1, Columns.Count).End(xlToLeft).Offset(0,1).EntireColumn
            .Value = oneColumn.Value
        End With
    End If
Next oneColumn

You would need to have the SourceSheet and DestiationSheet set before that code runs.

Hey, I tried it but i think i am not doing something right. Sorry i am new in VBA. I need to paste the value from P3 (in the macro workbook) onwards.

Sub Upload()
InitializeSettings

Dim FindOrdernummer As Range
Dim FileToOpen As Variant
'Dim OpenBook As Workbook
Dim C As Range
Dim srcWB As Workbook
Dim SomeRow As Long
Dim srcRNG As Variant
Dim i As Long
Dim oneColumn  As Range
Dim MacroWb As Workbook
Dim OpenBook As Object

Set MacroWb = Application.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)
End If

For Each oneColumn In OpenBook.Columns
    If WorksheetFunction.CountIf(oneColumn, String(7, "P")) = WorksheetFunction.CountA(oneColumn) Then
        With MacroWb.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).EntireColumn
            .Value = oneColumn.Value
        End With
    End If
Next oneColumn

Application.ScreenUpdating = True


End Sub

 

[kanishkgarg]

Also, its not a string of 7, its values of exactly 7 characters in particular column.