use warnings; use strict; my %numbers = ( '210' => 'rg1000', '212' => 'rg1000', '214' => 'rg1000', '215' => 'rg1000', '218' => 'rg1003', '221' => 'rg1000', '222' => 'rg1003', '223' => 'rg1003', '224' => 'rg1003' ); my %groups; my %hits; for (sort keys %numbers) { my $part = substr $_, 0, 2; my $group = $numbers{$_}; if (exists $hits{"$part,$group"}) { # We've seen this prefix with this group before delete $groups {$hits{"$part,$group"}}; delete $groups {$hits{"$part,$group"}.",$group"}; $groups{"$part,$group"} = "$part => $group"; } elsif (exists $hits{$part}) { # new group for existing prefix $groups{"$_,$group"} = "$_ => $group"; $hits{"$part,$group"} = $_; } else { #new prefix $hits{$part} = $_; $hits{"$part,$group"} = "$_,$group"; $groups{"$_,$group"} = "$_ => $group"; } } foreach my $item (sort keys %groups) { print "$groups{$item}\n"; } #### 21 => rg1000 218 => rg1003 22 => rg1003 221 => rg1000