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

littlepete

littlepete

Well-known Member
Joined
Mar 26, 2015
Messages
503
Office Version
  1. 365
Platform
  1. Windows
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
 

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.
Sort by date Sort by votes
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)).
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
usable screenshots
Click to expand...
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
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Question
Flattening a hierarchy from 5 columns into a unique one
Replies
1
Views
459
Kerryx
K
S
  • Solved
Advanced(?): Excel formula to calculate duration based on three activity levels with reset for each change of level
Replies
8
Views
595
skm95
S
G
  • Question
VBA Save File Based On Filtered Change In Range
Replies
4
Views
449
GoHeels
G
M
  • Question
Copy values from row to another sheet matched to todays date
Replies
1
Views
282
Herakles
H
C
  • Question
Run vba on dataset using criteria and input data from another dataset?
Replies
0
Views
75
CaraM
C

Forum statistics

Threads
1,214,651
Messages
6,120,744
Members
448,989
Latest member
mariah3

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