from 134.5.8.3 to 134.5.8 to 134.5 and 134 and save each level

littlepete

Board Regular
Joined
Mar 26, 2015
Messages
224
hello all :)

how can i save in a value each level of my division's column:
if a1 contains: " 134.5.8.3 " i would like :
level1 = 134
level2 = 134.5
level3 = 134.5.8
and there is of course no need to "get" the complete string...
after that i will filter my list with those values, one level at a time, and mark them in a help column.

thx for the help :) !

pete
belgium
 

Some videos you may like

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).

MARK858

MrExcel MVP
Joined
Nov 12, 2010
Messages
13,827
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
  2. Mobile
Explain exactly what you mean by "each level of my division's column" and post some sample data so we can see exactly what we are dealing with (see my signature block for some ways to post usable screenshots (but you know that already)).
 

littlepete

Board Regular
Joined
Mar 26, 2015
Messages
224
hello

i downloaded that jeany thing to take a printscreen, i can take a printscreen but after that all chinese for me ...
under here my complete (not working partially) macro

what it does:
1. it stores all parts of the division string into levels
2. it filters one level at a time and marks the rows
3. at the end it will show all marked items.

one level would be : 134. - three levels would be : 134.5.8

what i live the achieve is that, in case of three levels: showing three rows (one for each level)
134.
134.5
134.5.8



Code:
Sub taalfilter() ' CONTROL T
Application.ScreenUpdating = False
Dim levelx As String, level1 As String, level2 As String, level3 As String
Dim level4 As String, level5 As String, level6 As String, level7 As String
Dim level8 As String, level9 As String, level10 As String
Dim aantalnivos As Integer
' 1. deze indeling vastleggen
levelx = Range("A" & ActiveCell.Row).Value
aantalnivos = Len(levelx) - Len(WorksheetFunction.Substitute(levelx, ".", ""))
MsgBox "aantal niveaus is: " & aantalnivos
' 2. alle filters verwijderen
With ActiveSheet
    If .AutoFilterMode Then
        Set Rng = .AutoFilter.Range
            If Rng.Rows.Count > Rng.SpecialCells(xlCellTypeVisible).Rows.Count Then
                .ShowAllData
            End If
    End If
End With
' 3. twee eerste letters indeling markeren voor elk level indeling
level1 = Mid(levelx, 1, Len(levelx) - InStr(1, levelx, "."))
level2 = Mid(level1, 1, Len(level1) - InStr(1, level1, "."))
level3 = Mid(level2, 1, Len(level2) - InStr(1, level2, "."))
level4 = Mid(level3, 1, Len(level3) - InStr(1, level3, "."))
level5 = Mid(level4, 1, Len(level4) - InStr(1, level4, "."))


'level1 = Left(levelx, WorksheetFunction.Find(".", levelx) - 1)
'level2 = Left(level1, WorksheetFunction.Find(".", level1) - 1)
'level3 = Left(level2, WorksheetFunction.Find(".", level2) - 1)
'level4 = Left(level3, WorksheetFunction.Find(".", level3) - 1)
'level5 = Left(level4, WorksheetFunction.Find(".", level4) - 1)


MsgBox _
"niveau 1: " & level1 & Chr(10) & _
"niveau 2: " & level2 & Chr(10) & _
"niveau 3: " & level3 & Chr(10) & _
"niveau 4: " & level4 & Chr(10) & _
"niveau 5: " & level5


Exit Sub
level1 = Mid(levelx, WorksheetFunction.Find(".", levelx) + 1, Len(levelx))
If aantalnivos = 1 Then GoTo einde
level2 = Mid(level1, WorksheetFunction.Find(".", level1) + 1, Len(level1))
If aantalnivos = 2 Then GoTo einde
level3 = Mid(level2, WorksheetFunction.Find(".", level2) + 1, Len(level2))
If aantalnivos = 3 Then GoTo einde
level4 = Mid(level3, WorksheetFunction.Find(".", level3) + 1, Len(level3))
If aantalnivos = 4 Then GoTo einde
level5 = Mid(level4, WorksheetFunction.Find(".", level4) + 1, Len(level4))
If aantalnivos = 5 Then GoTo einde
level6 = Mid(level5, WorksheetFunction.Find(".", level5) + 1, Len(level5))
If aantalnivos = 6 Then GoTo einde
level7 = Mid(level6, WorksheetFunction.Find(".", level6) + 1, Len(level6))
If aantalnivos = 7 Then GoTo einde
level8 = Mid(level7, WorksheetFunction.Find(".", level7) + 1, Len(level7))
If aantalnivos = 8 Then GoTo einde
level9 = Mid(level8, WorksheetFunction.Find(".", level8) + 1, Len(level8))
If aantalnivos = 9 Then GoTo einde
level10 = Mid(level9, WorksheetFunction.Find(".", level9) + 1, Len(level9))
' ====================================================================
einde:
' filteren op elk niveau en markeren
MsgBox _
"niveau 10: " & level10 & Chr(10) & _
" niveau 9: " & level9 & Chr(10) & _
" niveau 8: " & level8 & Chr(10) & _
" niveau 7: " & level7 & Chr(10) & _
" niveau 6: " & level6 & Chr(10) & _
" niveau 5: " & level5 & Chr(10) & _
" niveau 4: " & level4 & Chr(10) & _
" niveau 3: " & level3 & Chr(10) & _
" niveau 2: " & level2 & Chr(10) & _
" niveau 1: " & level1 & Chr(10) & _
" niveau 0: " & levelx
' filteren per niveau
' ===============================================================
On Error Resume Next
ActiveSheet.ShowAllData
ActiveSheet.Range("rngindeling").AutoFilter Field:=1
Selection.AutoFilter Field:=Range("rngindeling").Cells(2, 1).Column, _
Criteria1:=levelx, Operator:=xlAnd
Set rngfound = Cells.Find(levelx, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False)
MsgBox "levelx is hier : " & levelx
markeer
toonselectie
MsgBox "niveau 1"
' ===============================================================
ActiveSheet.ShowAllData
ActiveSheet.Range("rngindeling").AutoFilter Field:=1
Selection.AutoFilter Field:=Range("rngindeling").Cells(2, 1).Column, _
Criteria1:=level1, Operator:=xlAnd
Set rngfound = Cells.Find(level1, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False)
MsgBox "levelx is hier : " & level1
markeer
toonselectie
MsgBox "niveau 2"
If aantalnivos > 2 Then GoTo resultaat
' ===============================================================
ActiveSheet.ShowAllData
ActiveSheet.Range("rngindeling").AutoFilter Field:=1
Selection.AutoFilter Field:=Range("rngindeling").Cells(2, 1).Column, _
Criteria1:=level2, Operator:=xlAnd
Set rngfound = Cells.Find(level2, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False)
MsgBox "levelx is hier : " & level2
markeer
toonselectie
MsgBox "niveau 3"
If aantalnivos > 3 Then GoTo resultaat
' ===============================================================
ActiveSheet.ShowAllData
ActiveSheet.Range("rngindeling").AutoFilter Field:=1
Selection.AutoFilter Field:=Range("rngindeling").Cells(2, 1).Column, _
Criteria1:=level3, Operator:=xlAnd
Set rngfound = Cells.Find(level3, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False)
MsgBox "levelx is hier : " & level3
markeer
toonselectie
MsgBox "niveau 4"
If aantalnivos > 4 Then GoTo resultaat
' ===============================================================
ActiveSheet.ShowAllData
ActiveSheet.Range("rngindeling").AutoFilter Field:=1
Selection.AutoFilter Field:=Range("rngindeling").Cells(2, 1).Column, _
Criteria1:=level4, Operator:=xlAnd
Set rngfound = Cells.Find(level4, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False)
MsgBox "levelx is hier : " & level4
markeer
toonselectie
MsgBox "niveau 5"
If aantalnivos > 5 Then GoTo resultaat
' ===============================================================
ActiveSheet.ShowAllData
ActiveSheet.Range("rngindeling").AutoFilter Field:=1
Selection.AutoFilter Field:=Range("rngindeling").Cells(2, 1).Column, _
Criteria1:=level5, Operator:=xlAnd
Set rngfound = Cells.Find(level5, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False)
MsgBox "levelx is hier : " & level5
markeer
If aantalnivos > 6 Then GoTo resultaat
' ===============================================================
ActiveSheet.ShowAllData
ActiveSheet.Range("rngindeling").AutoFilter Field:=1
Selection.AutoFilter Field:=Range("rngindeling").Cells(2, 1).Column, _
Criteria1:=level6, Operator:=xlAnd
Set rngfound = Cells.Find(level6, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False)
MsgBox "levelx is hier : " & levelx
markeer
If aantalnivos > 7 Then GoTo resultaat
' ===============================================================
ActiveSheet.ShowAllData
ActiveSheet.Range("rngindeling").AutoFilter Field:=1
Selection.AutoFilter Field:=Range("rngindeling").Cells(2, 1).Column, _
Criteria1:=level7, Operator:=xlAnd
Set rngfound = Cells.Find(level7, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False)
MsgBox "levelx is hier : " & levelx
markeer
If aantalnivos > 8 Then GoTo resultaat
' ===============================================================
ActiveSheet.ShowAllData
ActiveSheet.Range("rngindeling").AutoFilter Field:=1
Selection.AutoFilter Field:=Range("rngindeling").Cells(2, 1).Column, _
Criteria1:=level8, Operator:=xlAnd
Set rngfound = Cells.Find(level8, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False)
MsgBox "levelx is hier : " & levelx
markeer
If aantalnivos > 9 Then GoTo resultaat
' ===============================================================
ActiveSheet.ShowAllData
ActiveSheet.Range("rngindeling").AutoFilter Field:=1
Selection.AutoFilter Field:=Range("rngindeling").Cells(2, 1).Column, _
Criteria1:=level9, Operator:=xlAnd
Set rngfound = Cells.Find(level9, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False)
MsgBox "levelx is hier : " & levelx
markeer
' ====================================================================
resultaat:
filteruit
toonselectie
Exit Sub
leeg:
Application.ScreenUpdating = True
tooneersterij
End Sub
 

MARK858

MrExcel MVP
Joined
Nov 12, 2010
Messages
13,827
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
  2. Mobile
Jeanie....

Select your data
click the addins tab
click EJH4e drop down
click Excel Jeanie Html
click Forum standard
click ok in the copied to clipboard box
right click in the thread and paste
It will look like gobbly gook
click Go Advanced and you will see how it looks once posted
 

MARK858

MrExcel MVP
Joined
Nov 12, 2010
Messages
13,827
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
  2. Mobile
usable screenshots
means something we can copy and paste into Excel so we don't have to retype data to test.
JPegs are not usable.
Hopefully somebody else will be willing to jump in to help you
 

Watch MrExcel Video

Forum statistics

Threads
1,122,214
Messages
5,594,876
Members
413,946
Latest member
richelg

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